X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_acic%2FdoubleTypeInference.ml;h=4910275ea48c291662f213bd72fdb3ddd5e462c1;hb=f5dfc6c24a393a4717a7b40689df768d271d9ac0;hp=905d1e6bc0be63568a8998ac6936f48cb59d2a78;hpb=cf45f0f766c147324e587522a4a3761b5ac13415;p=helm.git diff --git a/helm/software/components/cic_acic/doubleTypeInference.ml b/helm/software/components/cic_acic/doubleTypeInference.ml index 905d1e6bc..4910275ea 100644 --- a/helm/software/components/cic_acic/doubleTypeInference.ml +++ b/helm/software/components/cic_acic/doubleTypeInference.ml @@ -64,9 +64,10 @@ let rec does_not_occur n = | C.Lambda (name,so,dest) -> does_not_occur n so && does_not_occur (n + 1) dest - | C.LetIn (name,so,dest) -> + | C.LetIn (name,so,ty,dest) -> does_not_occur n so && - does_not_occur (n + 1) dest + does_not_occur n ty && + does_not_occur (n + 1) dest | C.Appl l -> List.fold_right (fun x i -> i && does_not_occur n x) l true | C.Var (_,exp_named_subst) @@ -119,8 +120,8 @@ let rec beta_reduce = C.Prod (n, beta_reduce s, beta_reduce t) | C.Lambda (n,s,t) -> C.Lambda (n, beta_reduce s, beta_reduce t) - | C.LetIn (n,s,t) -> - C.LetIn (n, beta_reduce s, beta_reduce t) + | C.LetIn (n,s,ty,t) -> + C.LetIn (n, beta_reduce s, beta_reduce ty, beta_reduce t) | C.Appl ((C.Lambda (name,s,t))::he::tl) -> let he' = S.subst he t in if tl = [] then @@ -271,10 +272,8 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty = (try match List.nth context (n - 1) with Some (_,C.Decl t) -> S.lift n t - | Some (_,C.Def (_,Some ty)) -> S.lift n ty - | Some (_,C.Def (bo,None)) -> - type_of_aux context (S.lift n bo) expectedty - | None -> raise RelToHiddenHypothesis + | Some (_,C.Def (_,ty)) -> S.lift n ty + | None -> raise RelToHiddenHypothesis with _ -> raise (NotWellTyped "Not a close term") ) @@ -290,11 +289,12 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty = [] -> [] | (Some (n,C.Decl t))::tl -> (Some (n,C.Decl (S.subst_meta l (S.lift i t))))::(aux (i+1) tl) - | (Some (n,C.Def (t,None)))::tl -> - (Some (n,C.Def ((S.subst_meta l (S.lift i t)),None))):: - (aux (i+1) tl) + | (Some (n,C.Def (t,ty)))::tl -> + (Some (n, + C.Def + ((S.subst_meta l (S.lift i t)),S.subst_meta l (S.lift i t)))):: + (aux (i+1) tl) | None::tl -> None::(aux (i+1) tl) - | (Some (_,C.Def (_,Some _)))::_ -> assert false in aux 1 canonical_context in @@ -356,21 +356,22 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty = in (* Checks suppressed *) C.Prod (n,s,type2) - | C.LetIn (n,s,t) -> + | C.LetIn (n,s,ty,t) -> (*CSC: What are the right expected types for the source and *) (*CSC: target of a LetIn? None used. *) (* Let's visit all the subterms that will not be visited later *) - let ty = type_of_aux context s None in + let _ = type_of_aux context ty None in + let _ = type_of_aux context s (Some ty) in let t_typ = (* Checks suppressed *) - type_of_aux ((Some (n,(C.Def (s,Some ty))))::context) t None + type_of_aux ((Some (n,(C.Def (s,ty))))::context) t None in (* CicSubstitution.subst s t_typ *) if does_not_occur 1 t_typ then (* since [Rel 1] does not occur in typ, substituting any term *) (* in place of [Rel 1] is equivalent to delifting once *) CicSubstitution.subst (C.Implicit None) t_typ else - C.LetIn (n,s,t_typ) + C.LetIn (n,s,ty,t_typ) | C.Appl (he::tl) when List.length tl > 0 -> (* let expected_hetype = @@ -590,7 +591,7 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty = in let rec check uris_and_types subst = match uris_and_types,subst with - _,[] -> [] + _,[] -> () | (uri,ty)::tytl,(uri',t)::substtl when uri = uri' -> ignore (type_of_aux context t (Some ty)) ; let tytl' =