]> matita.cs.unibo.it Git - helm.git/blobdiff - matitaB/components/grafite_engine/grafiteEngine.ml
compact coercion command: "coercion foo."
[helm.git] / matitaB / components / grafite_engine / grafiteEngine.ml
index 7febf874e3a25ac5defb81232663ace8756a3fe2..c0d9baee7e56c814773cdc993337d778cba68bf3 100644 (file)
@@ -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
@@ -79,11 +79,12 @@ let basic_eval_interpretation ~alias_only (dsc, (symbol, args), cic_appl_pattern
   else
    status
  in
- let mode = GrafiteAst.WithPreferences (*assert false*) in (* MATITA 1.0 VEDI SOTTO *)
  let diff =
-  [DisambiguateTypes.Symbol (symbol, 0), GrafiteAst.Symbol_alias (symbol,0,dsc)]
+  (* FIXME! the uri should be filled with something meaningful! *)
+  [DisambiguateTypes.Symbol symbol,
+   GrafiteAst.Symbol_alias (symbol,None,dsc)]
  in
-  GrafiteDisambiguate.set_proof_aliases status ~implicit_aliases:false mode diff
+  GrafiteDisambiguate.add_to_disambiguation_univ status diff
 ;;
 
 let inject_interpretation =
@@ -113,7 +114,8 @@ let eval_interpretation status data=
 ;;
 
 let basic_eval_alias (mode,diff) status =
-  GrafiteDisambiguate.set_proof_aliases status ~implicit_aliases:false mode diff
+  prerr_endline "basic_eval_alias";
+  GrafiteDisambiguate.add_to_disambiguation_univ status diff
 ;;
 
 let inject_alias =
@@ -132,8 +134,14 @@ let eval_alias status data=
 let basic_eval_input_notation (l1,l2) status =
   GrafiteParser.extend status l1 
    (fun env loc ->
-     NotationPt.AttributedTerm
-      (`Loc loc,TermContentPres.instantiate_level2 status env l2)) 
+     let rec get_disamb = function
+     | [] -> Stdpp.dummy_loc,None,None
+     | (_,(NotationEnv.NoType,NotationEnv.DisambiguationValue dv))::_ -> dv
+     | _::tl -> get_disamb tl
+     in
+     let l2' = TermContentPres.instantiate_level2 status env (get_disamb env) l2 in
+     prerr_endline ("new l2 ast : " ^ (NotationPp.pp_term status l2'));
+     NotationPt.AttributedTerm (`Loc loc,l2')) 
 ;;
 
 let inject_input_notation =
@@ -144,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
@@ -175,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
@@ -198,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 
@@ -314,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
@@ -485,7 +493,32 @@ 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.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 *)
@@ -599,7 +632,8 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
                                 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 =
@@ -617,7 +651,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
                try
                  let metasenv,subst,status,t =
                   GrafiteDisambiguate.disambiguate_nterm status None [] [] []
-                   ("",0,NotationPt.Ident (name,None)) in
+                   ("",0,NotationPt.Ident (name,`Ambiguous)) in
                  assert (metasenv = [] && subst = []);
                  let status, nuris = 
                    NCicCoercDeclaration.
@@ -708,8 +742,10 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
       let metasenv,subst,status,sort = match sort with
         | None -> [],[],status,NCic.Sort NCic.Prop
         | Some s ->
-           GrafiteDisambiguate.disambiguate_nterm status None [] [] []
-            (text,prefix_len,s) 
+            let metasenv,subst,status,sort = 
+              GrafiteDisambiguate.disambiguate_nterm status None [] [] []
+              (text,prefix_len,s) 
+            in metasenv,subst,status,sort
       in
       assert (metasenv = []);
       let sort = NCicReduction.whd status ~subst [] sort in
@@ -752,6 +788,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
      in
       eval_interpretation status (dsc,(symbol, args),cic_appl_pattern)
   | GrafiteAst.Notation (loc, dir, l1, associativity, precedence, l2) ->
+      prerr_endline ("new notation: " ^ (NotationPp.pp_term status l1));
       let l1 = 
         CicNotationParser.check_l1_pattern
          l1 (dir = Some `RightToLeft) precedence associativity
@@ -760,8 +797,11 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
         if dir <> Some `RightToLeft then eval_input_notation status (l1,l2)
         else status
       in
+      let status =
        if dir <> Some `LeftToRight then eval_output_notation status (l1,l2)
        else status
+      in prerr_endline ("new grammar:\n" ^ (Print_grammar.ebnf_of_term status));
+      status
   | GrafiteAst.Alias (loc, spec) -> 
      let diff =
       (*CSC: Warning: this code should be factorized with the corresponding
@@ -769,10 +809,10 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
       match spec with
       | GrafiteAst.Ident_alias (id,uri) -> 
          [DisambiguateTypes.Id id,spec]
-      | GrafiteAst.Symbol_alias (symb, instance, desc) ->
-         [DisambiguateTypes.Symbol (symb,instance),spec]
-      | GrafiteAst.Number_alias (instance,desc) ->
-         [DisambiguateTypes.Num instance,spec]
+      | GrafiteAst.Symbol_alias (symb, uri, desc) ->
+         [DisambiguateTypes.Symbol symb,spec]
+      | GrafiteAst.Number_alias (uri,desc) ->
+         [DisambiguateTypes.Num,spec]
      in
       let mode = GrafiteAst.WithPreferences in(*assert false in (* VEDI SOPRA *) MATITA 1.0*)
        eval_alias status (mode,diff)