Matitaweb:

[helm.git] / matitaB / components / grafite_engine / grafiteEngine.ml

diff --git a/matitaB/components/grafite_engine/grafiteEngine.ml b/matitaB/components/grafite_engine/grafiteEngine.ml
index a0b00150f2fc5a1563a68155f7e0f2bff45ef6f2..2021114853c7368a86fc5512715d69b814837812 100644 (file)
--- a/matitaB/components/grafite_engine/grafiteEngine.ml
+++ b/matitaB/components/grafite_engine/grafiteEngine.ml
@@ -44,7 +44,7 @@ let inject_unification_hint =
    ~alias_only status
  =
   if not alias_only then
-   let t = refresh_uri_in_term (status :> NCic.status) t in
+   let t = refresh_uri_in_term (status :> NCicEnvironment.status) t in
     basic_eval_unification_hint (t,n) status
   else
    status
@@ -152,10 +152,10 @@ let inject_input_notation =
    if not alias_only then
     let l1 =
      CicNotationParser.refresh_uri_in_checked_l1_pattern
-      ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status))
+      ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status))
       ~refresh_uri_in_reference l1 in
     let l2 = NotationUtil.refresh_uri_in_term
-      ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status))
+      ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status))
       ~refresh_uri_in_reference l2
     in
      basic_eval_input_notation (l1,l2) status
@@ -183,10 +183,10 @@ let inject_output_notation =
   if not alias_only then
    let l1 =
     CicNotationParser.refresh_uri_in_checked_l1_pattern
-     ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status))
+     ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status))
       ~refresh_uri_in_reference l1 in
    let l2 = NotationUtil.refresh_uri_in_term
-     ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCic.status))
+     ~refresh_uri_in_term:(refresh_uri_in_term (status:>NCicEnvironment.status))
       ~refresh_uri_in_reference l2
    in
     basic_eval_output_notation (l1,l2) status
@@ -206,7 +206,7 @@ let record_index_obj =
  let aux l ~refresh_uri_in_universe 
    ~refresh_uri_in_term ~refresh_uri_in_reference ~alias_only status
  =
-  let refresh_uri_in_term = refresh_uri_in_term (status:>NCic.status) in
+  let refresh_uri_in_term = refresh_uri_in_term (status:>NCicEnvironment.status) in
   if not alias_only then
     basic_index_obj
       (List.map 
@@ -322,7 +322,7 @@ let inject_constraint =
     (* NCicLibrary.add_constraint adds the constraint to the NCicEnvironment
      * and also to the storage (for undo/redo). During inclusion of compiled
      * files the storage must not be touched. *)
-    NCicEnvironment.add_lt_constraint u1 u2;
+    NCicEnvironment.add_lt_constraint status u1 u2;
     status
   else
    status
@@ -354,7 +354,7 @@ let eval_ng_tac tac =
        ) seqs)
   | GrafiteAst.NAuto (_loc, (None,a)) -> 
       NnAuto.auto_tac ~params:(None,a) ?trace_ref:None
-  | GrafiteAst.NAuto (_loc, (Some l,a)) ->
+  | GrafiteAst.NAuto (_loc, (Some (_,l),a)) ->
       NnAuto.auto_tac
        ~params:(Some List.map (fun x -> "",0,x) l,a) ?trace_ref:None
   | GrafiteAst.NBranch _ -> NTactics.branch_tac ~force:false
@@ -493,13 +493,38 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
       GrafiteTypes.Serializer.require
        ~alias_only ~baseuri ~fname:fullpath status
   | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n
-  | GrafiteAst.NCoercion (loc, name, t, ty, source, target) ->
+  | GrafiteAst.NCoercion (loc, name, None) ->
+     let status, t, ty, source, target =
+       let o_t = NotationPt.Ident (name,`Ambiguous) in
+       let metasenv,subst, status,t =
+         GrafiteDisambiguate.disambiguate_nterm 
+           status None [] [] [] ("",0,o_t) in
+       assert( metasenv = [] && subst = []);
+       let ty = NCicTypeChecker.typeof status [] [] [] t in
+       let source, target =
+         let clean = function
+         | NCic.Appl (NCic.Const _ as r :: l) -> 
+             NotationPt.Appl (NotationPt.NCic r ::
+               List.map (fun _ -> NotationPt.Implicit `JustOne)l)
+         | NCic.Const _ as r -> NotationPt.NCic r
+         | _ -> assert false in
+         let rec aux = function
+         | NCic.Prod (_,_, (NCic.Prod _ as rest)) -> aux rest
+         | NCic.Prod (name, src, tgt) -> (name, clean src), clean tgt
+         | _ -> assert false in aux ty in
+       status, o_t, NotationPt.NCic ty, source, target in
      let status, composites =
       NCicCoercDeclaration.eval_ncoercion status name t ty source target in
      let mode = GrafiteAst.WithPreferences in (* MATITA 1.0: fixme *)
      let aliases = GrafiteDisambiguate.aliases_for_objs status composites in
       eval_alias status (mode,aliases)
-  | GrafiteAst.NQed loc ->
+  | GrafiteAst.NCoercion (loc, name, Some (t, ty, source, target)) ->
+     let status, composites =
+      NCicCoercDeclaration.eval_ncoercion status name t ty source target in
+     let mode = GrafiteAst.WithPreferences in (* MATITA 1.0: fixme *)
+     let aliases = GrafiteDisambiguate.aliases_for_objs status composites in
+      eval_alias status (mode,aliases)
+  | GrafiteAst.NQed (loc,index) ->
      if status#ng_mode <> `ProofMode then
       raise (GrafiteTypes.Command_error "Not in proof mode")
      else
@@ -534,7 +559,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
         let obj = uri,height,[],[],obj_kind in
         let old_status = status in
         let status = NCicLibrary.add_obj status obj in
-        let index_obj =
+        let index_obj = index &&
          match obj_kind with
             NCic.Constant (_,_,_,_,(_,`Example,_))
           | NCic.Fixpoint (_,_,(_,`Example,_)) -> false
@@ -579,7 +604,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
                 else
                   nstatus
                with
-               | MultiPassDisambiguator.DisambiguationError _
+               | GrafiteDisambiguate.Error _
                | NCicTypeChecker.TypeCheckerFailure _ ->
                   (*HLog.warn "error in generating projection/eliminator";*)
                   status
@@ -600,14 +625,15 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
                        let _,_,menv,_,_ = invobj in
                         (match menv with
                              [] -> eval_ncommand ~include_paths opts status
-                                    ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+                                    ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false))
                            | _ -> status))
                        (* XXX *)
                       with _ -> (*HLog.warn "error in generating inversion principle"; *)
                                 let status = status#set_ng_mode `CommandMode in status)
                   status
                   (NCic.Prop::
-                    List.map (fun s -> NCic.Type s) (NCicEnvironment.get_universes ()))
+                    List.map (fun s -> NCic.Type s)
+                    (NCicEnvironment.get_universes status))
               | _ -> status
            in
            let coercions =
@@ -633,7 +659,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
                       status (name,t,cpos,arity) in
                  let aliases = GrafiteDisambiguate.aliases_for_objs status nuris in
                   eval_alias status (mode,aliases)
-               with MultiPassDisambiguator.DisambiguationError _-> 
+               with GrafiteDisambiguate.Error _ -> 
                  HLog.warn ("error in generating coercion: "^name);
                  status) 
              status coercions
@@ -673,7 +699,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
        let status = status#set_stack ninitial_stack in
        let status = subst_metasenv_and_fix_names status in
        let status = status#set_ng_mode `ProofMode in
-       eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+       eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false))
   | GrafiteAst.NObj (loc,obj) ->
      if status#ng_mode <> `CommandMode then
       raise (GrafiteTypes.Command_error "Not in command mode")
@@ -689,7 +715,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
       let status = status#set_ng_mode `ProofMode in
       (match nmenv with
           [] ->
-           eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+           eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,true))
         | _ -> status)
   | GrafiteAst.NDiscriminator (_,_) -> assert false (*(loc, indty) ->
       if status#ng_mode <> `CommandMode then
@@ -750,7 +776,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
        (match menv with
           [] ->
             eval_ncommand ~include_paths opts status
-             ("",0,GrafiteAst.NQed Stdpp.dummy_loc)
+             ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false))
         | _ -> assert false)
   | GrafiteAst.NUnivConstraint (loc,u1,u2) ->
       eval_add_constraint status [`Type,u1] [`Type,u2]
@@ -804,6 +830,7 @@ let rec eval_executable ~include_paths opts status (text,prefix_len,ex) =
         List.fold_left 
           (fun status tac ->
             let status = eval_ng_tac (text,prefix_len,tac) status in
+            prerr_endline "prima di subst_metasenv_and_fix_names";
             subst_metasenv_and_fix_names status)
           status tacl
        in