Final answer: the local context MUST be normalized w.r.t. the canonical

[helm.git] / helm / ocaml / cic_unification / cicMkImplicit.ml

diff --git a/helm/ocaml/cic_unification/cicMkImplicit.ml b/helm/ocaml/cic_unification/cicMkImplicit.ml
index 24a94514e8703dd5ca92d7feb526bbf31930fd80..1817ac8613873ecd2276fae3da36f156d4afda7e 100644 (file)
--- a/helm/ocaml/cic_unification/cicMkImplicit.ml
+++ b/helm/ocaml/cic_unification/cicMkImplicit.ml
@@ -3,7 +3,7 @@
 (* returns the identity relocation list, which is the list [1 ; ... ; n] *)
 (* where n = List.length [canonical_context]                             *)
 (*CSC: ma mi basta la lunghezza del contesto canonico!!!*)
-let identity_relocation_list_for_metavariable canonical_context =
+let identity_relocation_list_for_metavariable ?(start = 1) canonical_context =
  let canonical_context_length = List.length canonical_context in
   let rec aux =
    function
@@ -11,7 +11,7 @@ let identity_relocation_list_for_metavariable canonical_context =
     | (n,None::tl) -> None::(aux ((n+1),tl))
     | (n,_::tl) -> (Some (Cic.Rel n))::(aux ((n+1),tl))
   in
-   aux (1,canonical_context)
+   aux (start,canonical_context)
 
 (* Returns the first meta whose number is above the *)
 (* number of the higher meta.                       *)
@@ -33,9 +33,33 @@ let mk_implicit metasenv context =
     newmeta + 2, context, Cic.Meta (newmeta + 1,irl) ] @ metasenv,
    newmeta + 2)
 
-let mk_implicit' metasenv context =
-  let (metasenv, index) = mk_implicit metasenv context in
-  (metasenv, index - 1, index)
+let n_fresh_metas metasenv context n = 
+  if n = 0 then metasenv, []
+  else 
+    let irl = identity_relocation_list_for_metavariable context in
+    let newmeta = new_meta metasenv in
+    let rec aux newmeta n = 
+      if n = 0 then metasenv, [] 
+      else
+        let metasenv', l = aux (newmeta + 3) (n-1) in 
+        (newmeta, context, Cic.Sort Cic.Type)::
+        (newmeta + 1, context, Cic.Meta (newmeta, irl))::
+        (newmeta + 2, context, Cic.Meta (newmeta + 1,irl))::metasenv',
+        Cic.Meta(newmeta+2,irl)::l in
+    aux newmeta n
+      
+let fresh_subst metasenv context uris = 
+  let irl = identity_relocation_list_for_metavariable context in
+  let newmeta = new_meta metasenv in
+  let rec aux newmeta = function
+      [] -> metasenv, [] 
+    | uri::tl ->
+       let metasenv', l = aux (newmeta + 3) tl in 
+         (newmeta, context, Cic.Sort Cic.Type)::
+         (newmeta + 1, context, Cic.Meta (newmeta, irl))::
+         (newmeta + 2, context, Cic.Meta (newmeta + 1,irl))::metasenv',
+          (uri,Cic.Meta(newmeta+2,irl))::l in
+    aux newmeta uris
 
 let mk_implicit_type metasenv context =
   let newmeta = new_meta metasenv in
@@ -64,9 +88,9 @@ let expand_implicits metasenv context term =
         let metasenv', l' = do_local_context metasenv context l in
         metasenv', Cic.Meta (n, l')
     | Cic.Implicit ->
-        let (metasenv', type_index, _) = mk_implicit' metasenv context in
+        let (metasenv', idx) = mk_implicit metasenv context in
         let irl = identity_relocation_list_for_metavariable context in
-        metasenv', Cic.Meta (type_index, irl)
+        metasenv', Cic.Meta (idx, irl)
     | Cic.Cast (te, ty) ->
         let metasenv', ty' = aux metasenv context ty in
         let metasenv'', te' = aux metasenv' context te in
@@ -138,7 +162,7 @@ let expand_implicits metasenv context term =
           | ((name, index, _, _) :: funs_tl),
             ((_, typ) :: typ_tl),
             (body :: body_tl) ->
-              (name, index, typ, term) :: combine (funs_tl, typ_tl, body_tl)
+              (name, index, typ, body) :: combine (funs_tl, typ_tl, body_tl)
           | [], [], [] -> []
           | _ -> assert false
         in
@@ -169,7 +193,7 @@ let expand_implicits metasenv context term =
           | ((name, _, _) :: funs_tl),
             ((_, typ) :: typ_tl),
             (body :: body_tl) ->
-              (name, typ, term) :: combine (funs_tl, typ_tl, body_tl)
+              (name, typ, body) :: combine (funs_tl, typ_tl, body_tl)
           | [], [], [] -> []
           | _ -> assert false
         in