fact: Fixpoint extract (env : nat -> nat) (s : Ast.term) (fuel : nat) : TemplateMonad L.term := match fuel with 0 => tmFail "out of fuel" | S fuel => match s with Ast.tRel n => t <- tmEval cbv (var (env n));; ret t | Ast.tLambda _ _ s => t <- extract (↑ env) s fuel ;; ret (lam t) | Ast.tFix [BasicAst.mkdef nm ty s _] _ => t <- extract (fun n => S (env n)) (Ast.tLambda nm ty s) fuel ;; ret (rho t) | Ast.tApp s R => res <- inferHead s R;; let '(res,R') := res in t <- (match res with inl s' => ret s' | inr s => extract env s fuel end);; monad_fold_left (fun t1 s2 => t2 <- extract env s2 fuel ;; ret (L.app t1 t2)) R' t | Ast.tConst n _ => a <- tmUnquote s ;; a' <- tmEval cbn (my_projT2 a);; n <- (tmEval cbv (String.append (name_of s) "_term") >>= tmFreshName) ;; i <- tmTryInfer n (Some cbn) (extracted a') ;; ret (@int_ext _ _ i) | Ast.tConstruct (mkInd n _) _ _ => a <- tmUnquote s ;; a' <- tmEval cbn (my_projT2 a);; nm <- (tmEval cbv (String.append (name_of s) "_term") >>= tmFreshName) ;; i <- tmTryInfer nm (Some cbn) (extracted a') ;; ret (@int_ext _ _ i) | Ast.tCase _ _ s cases => t <- extract env s fuel ;; M <- monad_fold_left (fun t1 br => len <- tmEval cbv (List.length br.(bcontext)) ;; t2 <- extract (fun i => S (it lift (len) env i)) br.(bbody) fuel ;; t2' <- tmEval cbn (it lam len (lam t2)) ;; ret (L.app t1 t2')) cases t ;; ret (L.app M I) | Ast.tLetIn _ s1 _ s2 => t1 <- extract env s1 fuel ;; t2 <- extract (↑ env) s2 fuel ;; ret( L.app (lam t2) t1) | Ast.tFix _ _ => tmFail "Mutual Fixpoints are not supported" | tVar _ => a <- tmUnquote s ;; a' <- tmEval cbn (my_projT2 a);; n <- (tmEval cbv (String.append (name_of s) "_term") >>= tmFreshName) ;; i <- tmTryInfer n (Some cbn) (extracted a') ;; ret (@int_ext _ _ i) | tEvar _ _ => tmFail "tEvar is not supported" | tSort _ => tmFail "tSort is not supported" | tCast _ _ _ => tmFail "tCast is not supported" | tProd _ _ _ => tmFail "tProd is not supported" | tInd a _ => tmPrint a;;tmFail "tInd is not supported (probably there is a type not in prenex-normal form)" | tProj _ _ => tmFail "tProj is not supported" | tCoFix _ _ => tmFail "tCoFix is not supported" | tInt _ => tmFail "tInt is not supported" | tFloat _ => tmFail "tFloat is not supported" end end.
imports: Ascii String Undecidability.L(Util.L_facts) MetaCoq(Template.All Template.Checker) Undecidability.Shared.Libs.PSL.Base MetaCoq.Utils.bytestring