new instantiate, only known bug is w.r.t. in/out scope and file matita/contribs/ng_as...

[helm.git] / helm / software / components / ng_refiner / nCicRefiner.ml

diff --git a/helm/software/components/ng_refiner/nCicRefiner.ml b/helm/software/components/ng_refiner/nCicRefiner.ml
index c3765f3f0261eb092bbb93e87c8e12df6d0a9bc7..8c92d3328b8556e9ecb91912e140a6f09dee3736 100644 (file)
--- a/helm/software/components/ng_refiner/nCicRefiner.ml
+++ b/helm/software/components/ng_refiner/nCicRefiner.ml
@@ -57,12 +57,11 @@ let wrap_exc msg = function
   | e -> raise e
 ;;
 
-let exp_implicit rdb ~localise metasenv subst context expty t =
- let foo x = function Some t -> `WithType t | None -> x in
+let exp_implicit rdb ~localise metasenv subst context with_type t =
  function      
   | `Closed ->
       let metasenv,subst,expty =
-       match expty with
+       match with_type with
           None -> metasenv,subst,None
         | Some typ ->
            let (metasenv,subst),typ =
@@ -80,11 +79,12 @@ let exp_implicit rdb ~localise metasenv subst context expty t =
            in
             metasenv,subst,Some typ
       in
-       NCicMetaSubst.mk_meta metasenv [] (foo `Term expty),subst
-  | `Type -> NCicMetaSubst.mk_meta metasenv context (foo `Type expty),subst
-  | `Term -> NCicMetaSubst.mk_meta metasenv context (foo `Term expty),subst
+       NCicMetaSubst.mk_meta metasenv [] ?with_type:expty `IsTerm,subst
+  | `Type -> NCicMetaSubst.mk_meta metasenv context ?with_type `IsType,subst
+  | `Term -> NCicMetaSubst.mk_meta metasenv context ?with_type `IsTerm,subst
   | `Tagged s ->
-      NCicMetaSubst.mk_meta ~attrs:[`Name s] metasenv context (foo `Term expty),subst
+      NCicMetaSubst.mk_meta 
+        ~attrs:[`Name s] metasenv context ?with_type `IsTerm,subst
   | `Vector ->
       raise (RefineFailure (lazy (localise t, "A vector of implicit terms " ^
        "can only be used in argument position")))
@@ -106,7 +106,7 @@ let check_allowed_sort_elimination rdb localise r orig =
      match arity1 with
      | C.Prod (name,so1,de1) (* , t ==?== C.Prod _ *) ->
         let metasenv, _, meta, _ = 
-          NCicMetaSubst.mk_meta metasenv ((name,C.Decl so1)::context) `Type 
+          NCicMetaSubst.mk_meta metasenv ((name,C.Decl so1)::context) `IsType 
         in
         let metasenv, subst = 
           try NCicUnification.unify rdb metasenv subst context 
@@ -119,7 +119,7 @@ let check_allowed_sort_elimination rdb localise r orig =
         aux metasenv subst ((name, C.Decl so1)::context)
          (mkapp (NCicSubstitution.lift 1 ind) (C.Rel 1)) de1 meta
      | C.Sort _ (* , t ==?== C.Prod _ *) ->
-        let metasenv, _, meta, _ = NCicMetaSubst.mk_meta metasenv [] `Type in
+        let metasenv, _, meta, _ = NCicMetaSubst.mk_meta metasenv [] `IsSort in
         let metasenv, subst = 
           try NCicUnification.unify rdb metasenv subst context 
                 arity2 (C.Prod ("_", ind, meta)) 
@@ -198,21 +198,16 @@ let rec typeof rdb
          let (metasenv,_,t,ty),subst =
            exp_implicit rdb ~localise metasenv subst context expty t infos
          in
+         if expty = None then
+          typeof_aux metasenv subst context None t
+         else
           metasenv, subst, t, ty 
     | C.Meta (n,l) as t -> 
-       let ty =
+       let metasenv, ty =
         try
-         let _,_,_,ty = NCicUtils.lookup_subst n subst in ty 
-        with NCicUtils.Subst_not_found _ -> try
-         let _,_,ty = NCicUtils.lookup_meta n metasenv in 
-         match ty with C.Implicit _ -> 
-                 prerr_endline (string_of_int n);
-                 prerr_endline (NCicPp.ppmetasenv ~subst metasenv);
-                 prerr_endline (NCicPp.ppsubst ~metasenv subst);
-                 assert false | _ -> ty 
-        with NCicUtils.Meta_not_found _ ->
-         raise (AssertFailure (lazy (Printf.sprintf
-          "%s not found" (NCicPp.ppterm ~subst ~metasenv ~context t))))
+         let _,_,_,ty = NCicUtils.lookup_subst n subst in metasenv, ty 
+        with NCicUtils.Subst_not_found _ ->
+         NCicMetaSubst.extend_meta metasenv n
        in
        metasenv, subst, t, NCicSubstitution.subst_meta l ty
     | C.Const _ -> 
@@ -252,7 +247,7 @@ let rec typeof rdb
              (try 
                pp(lazy("Force source to: "^NCicPp.ppterm ~metasenv ~subst
                   ~context exp_s));
-               NCicUnification.unify rdb metasenv subst context s exp_s,exp_ty_t
+               NCicUnification.unify ~test_eq_only:true rdb metasenv subst context s exp_s,exp_ty_t
              with exc -> raise (wrap_exc (lazy (localise orig_s, Printf.sprintf
                "Source type %s was expected to be %s" (NCicPp.ppterm ~metasenv
                ~subst ~context s) (NCicPp.ppterm ~metasenv ~subst ~context
@@ -343,16 +338,11 @@ let rec typeof rdb
       (* next lines are to do a subst-expansion of the outtype, so
          that when it becomes a beta-abstraction, the beta-redex is
          fired during substitution *)
-      (*CSC: this is instantiate! should we move it from tactics to the
-             refiner? I think so! *)
-      let metasenv,metanoouttype,newouttype,metaoutsort =
-       NCicMetaSubst.mk_meta metasenv context `Term in
-      let metasenv,subst =
-       NCicUnification.unify rdb metasenv subst context outsort metaoutsort in
-      let metasenv =
-       List.filter (function (j,_) -> j <> metanoouttype) metasenv in
+      let _,fresh_metanoouttype,newouttype,_ =
+       NCicMetaSubst.mk_meta metasenv context `IsTerm in
       let subst =
-       (metanoouttype,([`Name "outtype"],context,outtype,metaoutsort))::subst in
+       (fresh_metanoouttype,([`Name "outtype"],context,outtype,outsort))
+         ::subst in
       let outtype = newouttype in
 
       (* let's control if the sort elimination is allowed: [(I q1 ... qr)|B] *)
@@ -476,7 +466,10 @@ and force_to_sort rdb metasenv subst context t orig_t localise ty =
   | C.Sort _ as ty -> metasenv, subst, t, ty 
   | ty -> 
       try_coercions rdb ~localise metasenv subst context
-        t orig_t ty (NCic.Sort (NCic.Type NCicEnvironment.type0)) false 
+        t orig_t ty (NCic.Sort (NCic.Type 
+          (match NCicEnvironment.get_universes () with
+           | x::_ -> x 
+           | _ -> assert false))) false 
          (Uncertain (lazy (localise orig_t, 
          "The type of " ^ NCicPp.ppterm ~metasenv ~subst ~context t
          ^ " is not a sort: " ^ NCicPp.ppterm ~metasenv ~subst ~context ty)))
@@ -565,7 +558,7 @@ and eat_prods rdb ~localise force_ty metasenv subst context expty orig_t orig_he
           let name = guess_name subst context ty_arg in
           let metasenv, _, meta, _ = 
             NCicMetaSubst.mk_meta metasenv 
-              ((name,C.Decl ty_arg) :: context) `Type
+              ((name,C.Decl ty_arg) :: context) `IsType
           in
           let flex_prod = C.Prod (name, ty_arg, meta) in
           (* next line grants that ty_args is a type *)