]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/matita/matitaEngine.ml
added support for MATITA_FLAGS and NODB make variables
[helm.git] / helm / matita / matitaEngine.ml
index 9a194b5ba19e00e3a382b02b0b77fc815eeb2e7d..61d69cbb9ace3b7770692205870fd840749e29b2 100644 (file)
@@ -65,8 +65,8 @@ let tactic_of_ast ast =
   | GrafiteAst.Absurd (_, term) -> Tactics.absurd term
   | GrafiteAst.Apply (_, term) -> Tactics.apply term
   | GrafiteAst.Assumption _ -> Tactics.assumption
-  | GrafiteAst.Auto (_,depth,width,paramodulation) ->
-      AutoTactic.auto_tac ?depth ?width ?paramodulation
+  | GrafiteAst.Auto (_,depth,width,paramodulation,full) ->
+      AutoTactic.auto_tac ?depth ?width ?paramodulation ?full
         ~dbd:(MatitaDb.instance ()) ()
   | GrafiteAst.Change (_, pattern, with_what) ->
      Tactics.change ~pattern with_what
@@ -227,8 +227,8 @@ let disambiguate_tactic status tactic =
         let cic = disambiguate_term status_ref term in
         GrafiteAst.Apply (loc, cic)
     | GrafiteAst.Assumption loc -> GrafiteAst.Assumption loc
-    | GrafiteAst.Auto (loc,depth,width,paramodulation) ->
-        GrafiteAst.Auto (loc,depth,width,paramodulation)
+    | GrafiteAst.Auto (loc,depth,width,paramodulation,full) ->
+        GrafiteAst.Auto (loc,depth,width,paramodulation,full)
     | GrafiteAst.Change (loc, pattern, with_what) -> 
         let with_what = disambiguate_lazy_term status_ref with_what in
         let pattern = disambiguate_pattern status_ref pattern in
@@ -634,7 +634,7 @@ let generate_projections uri fields status =
   ) status projections
 
 (* to avoid a long list of recursive functions *)
-let eval_from_stream_ref = ref (fun _ _ _ -> assert false);;
+let eval_from_moo_ref = ref (fun _ _ _ -> assert false);;
  
 let disambiguate_obj status obj =
   let uri =
@@ -660,13 +660,15 @@ let disambiguate_obj status obj =
   let status = MatitaSync.set_proof_aliases status diff in
   status, cic
   
-let disambiguate_command status = function
+let disambiguate_command status =
+  function
   | GrafiteAst.Alias _
   | GrafiteAst.Default _
   | GrafiteAst.Drop _
   | GrafiteAst.Dump _
   | GrafiteAst.Include _
   | GrafiteAst.Interpretation _
+  | GrafiteAst.Metadata _
   | GrafiteAst.Notation _
   | GrafiteAst.Qed _
   | GrafiteAst.Render _
@@ -696,8 +698,6 @@ let make_absolute paths path =
    with Unix.Unix_error _ as exc -> raise (UnableToInclude path)
 ;;
        
-let profiler_include = HExtlib.profile "include"
-
 let eval_command opts status cmd =
   let status,cmd = disambiguate_command status cmd in
   let cmd,notation_ids' = CicNotation.process_notation cmd in
@@ -711,35 +711,34 @@ let eval_command opts status cmd =
   | GrafiteAst.Include (loc, path) ->
      let absolute_path = make_absolute opts.include_paths path in
      let moopath = MatitaMisc.obj_file_of_script absolute_path in
-     let ic =
-      try open_in moopath with Sys_error _ -> 
-        raise (IncludedFileNotCompiled moopath) in
-     let stream = Ulexing.from_utf8_channel ic in
      let status = ref status in
-      profiler_include.HExtlib.profile
-       (!eval_from_stream_ref status stream) (fun _ _ -> ());
-      close_in ic;
-      !status
+     if not (Sys.file_exists moopath) then
+       raise (IncludedFileNotCompiled moopath);
+     !eval_from_moo_ref status moopath (fun _ _ -> ());
+     !status
+  | GrafiteAst.Metadata (loc, m) ->
+      (match m with
+      | GrafiteAst.Dependency uri -> MatitaTypes.add_moo_metadata [m] status
+      | GrafiteAst.Baseuri _ -> status)
   | GrafiteAst.Set (loc, name, value) -> 
-      let value = 
-        if name = "baseuri" then
-          let v = MatitaMisc.strip_trailing_slash value in
-          try
-            ignore (String.index v ' ');
-            command_error "baseuri can't contain spaces"
-          with Not_found -> v
-        else
-          value
+      let status = 
+        if name = "baseuri" then begin
+          let value = 
+            let v = MatitaMisc.strip_trailing_slash value in
+            try
+              ignore (String.index v ' ');
+              command_error "baseuri can't contain spaces"
+            with Not_found -> v
+          in
+          if not (MatitaMisc.is_empty value) && opts.clean_baseuri then begin
+            MatitaLog.warn ("baseuri " ^ value ^ " is not empty");
+            MatitaLog.message ("cleaning baseuri " ^ value);
+            MatitacleanLib.clean_baseuris [value]
+          end;
+          add_moo_metadata [GrafiteAst.Baseuri value] status
+        end else
+          status
       in
-      if not (MatitaMisc.is_empty value) then
-        begin
-          MatitaLog.warn ("baseuri " ^ value ^ " is not empty");
-          if opts.clean_baseuri then
-            begin 
-              MatitaLog.message ("cleaning baseuri " ^ value);
-              MatitacleanLib.clean_baseuris [value]
-            end
-        end;
       set_option status name value
   | GrafiteAst.Drop loc -> raise Drop
   | GrafiteAst.Qed loc ->
@@ -759,8 +758,7 @@ let eval_command opts status cmd =
       let name = UriManager.name_of_uri uri in
       let obj = Cic.Constant (name,Some bo,ty,[],[]) in
       MatitaSync.add_obj uri obj status
-  | GrafiteAst.Coercion (loc, coercion) -> 
-      eval_coercion status coercion
+  | GrafiteAst.Coercion (loc, coercion) -> eval_coercion status coercion
   | GrafiteAst.Alias (loc, spec) -> 
      let diff =
       (*CSC: Warning: this code should be factorized with the corresponding
@@ -779,13 +777,20 @@ let eval_command opts status cmd =
       MatitaSync.set_proof_aliases status diff
   | GrafiteAst.Render _ -> assert false (* ZACK: to be removed *)
   | GrafiteAst.Dump _ -> assert false   (* ZACK: to be removed *)
-  | GrafiteAst.Interpretation (_, dsc, (symbol, _), _) as stm ->
-      let status' = add_moo_content [stm] status in
+  | GrafiteAst.Interpretation (_, dsc, (symbol, _), cic_appl_pattern) as stm ->
+      let status = add_moo_content [stm] status in
+      let uris =
+        List.map
+          (fun uri -> GrafiteAst.Dependency (UriManager.buri_of_uri uri))
+          (CicNotationUtil.find_appl_pattern_uris cic_appl_pattern)
+      in
       let diff =
        [DisambiguateTypes.Symbol (symbol, 0),
          DisambiguateChoices.lookup_symbol_by_dsc symbol dsc]
       in
-      MatitaSync.set_proof_aliases status' diff
+      let status = MatitaSync.set_proof_aliases status diff in
+      let status = MatitaTypes.add_moo_metadata uris status in
+      status
   | GrafiteAst.Notation _ as stm -> add_moo_content [stm] status
   | GrafiteAst.Obj (loc,obj) ->
      let ext,name =
@@ -878,7 +883,6 @@ let eval_executable opts status ex =
 
 let eval_comment status c = status
             
-
 let eval_ast 
   ?(do_heavy_checks=false) ?(include_paths=[]) ?(clean_baseuri=true) status st 
 =
@@ -891,6 +895,31 @@ let eval_ast
   | GrafiteAst.Executable (_,ex) -> eval_executable opts status ex
   | GrafiteAst.Comment (_,c) -> eval_comment status c
 
+let eval_from_moo ?do_heavy_checks ?include_paths ?clean_baseuri status fname cb
+=
+  let ast_of_cmd cmd =
+    GrafiteAst.Executable (DisambiguateTypes.dummy_floc,
+      GrafiteAst.Command (DisambiguateTypes.dummy_floc,
+        (GrafiteAst.reash_cmd_uris cmd)))
+  in
+  let moo, metadata = MatitaMoo.load_moo fname in
+  List.iter 
+    (fun ast -> 
+      let ast = ast_of_cmd ast in
+      cb !status ast;
+      status :=
+        eval_ast ?do_heavy_checks ?include_paths ?clean_baseuri !status ast)
+    moo;
+  List.iter
+    (fun m ->
+      let ast =
+        ast_of_cmd (GrafiteAst.Metadata (DisambiguateTypes.dummy_floc, m))
+      in
+      cb !status ast;
+      status :=
+        eval_ast ?do_heavy_checks ?include_paths ?clean_baseuri !status ast)
+    metadata
+
 let eval_from_stream 
   ?do_heavy_checks ?include_paths ?clean_baseuri status str cb 
 =
@@ -898,12 +927,13 @@ let eval_from_stream
     while true do
       let ast = GrafiteParser.parse_statement str in
       cb !status ast;
-      status := eval_ast ?do_heavy_checks ?include_paths ?clean_baseuri !status ast
+      status :=
+        eval_ast ?do_heavy_checks ?include_paths ?clean_baseuri !status ast
     done
   with End_of_file -> ()
 
 (* to avoid a long list of recursive functions *)
-let _ = eval_from_stream_ref := eval_from_stream
+let _ = eval_from_moo_ref := eval_from_moo
   
 let eval_from_stream_greedy 
   ?do_heavy_checks ?include_paths ?clean_baseuri status str cb 
@@ -942,7 +972,7 @@ let initial_status =
   lazy {
     aliases = DisambiguateTypes.Environment.empty;
     multi_aliases = DisambiguateTypes.Environment.empty;
-    moo_content_rev = [];
+    moo_content_rev = [], [];
     proof_status = No_proof;
     options = default_options ();
     objects = [];