]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/matita/matitaEngine.ml
Debugging code commented out.
[helm.git] / helm / matita / matitaEngine.ml
index b456bb6eb39c57f45f3b301e6590adccd275f91e..9707149d568cd52bb87de6846f782bebce038322 100644 (file)
@@ -32,7 +32,11 @@ exception UnableToInclude of string;;
 let debug = false ;;
 let debug_print = if debug then prerr_endline else ignore ;;
 
-type options = { do_heavy_checks: bool ; include_paths: string list }
+type options = { 
+  do_heavy_checks: bool ; 
+  include_paths: string list ;
+  clean_baseuri: bool
+}
 
 type statement =
   (CicNotationPt.term, GrafiteAst.obj, string) GrafiteAst.statement
@@ -68,7 +72,15 @@ let tactic_of_ast = function
      let names = match ident with None -> [] | Some id -> [id] in
      Tactics.cut ~mk_fresh_name_callback:(namer_of names) term
   | GrafiteAst.DecideEquality _ -> Tactics.decide_equality
-  | GrafiteAst.Decompose (_,term) -> Tactics.decompose term
+  | GrafiteAst.Decompose (_, types, what, names) -> 
+      let to_type = function
+         | GrafiteAst.Type (uri, typeno) -> uri, typeno
+        | GrafiteAst.Ident _            -> assert false
+      in
+      let user_types = List.rev_map to_type types in
+      let dbd = MatitaDb.instance () in
+      let mk_fresh_name_callback = namer_of names in
+      Tactics.decompose ~mk_fresh_name_callback ~dbd ~user_types what
   | GrafiteAst.Discriminate (_,term) -> Tactics.discriminate term
   | GrafiteAst.Elim (_, what, using, depth, names) ->
       Tactics.elim_intros ?using ?depth ~mk_fresh_name_callback:(namer_of names) what
@@ -185,9 +197,18 @@ let disambiguate_tactic status = function
       status, GrafiteAst.Cut (loc, ident, cic)
   | GrafiteAst.DecideEquality loc ->
       status, GrafiteAst.DecideEquality loc
-  | GrafiteAst.Decompose (loc,term) ->
-      let status,term = disambiguate_term status term in
-      status, GrafiteAst.Decompose(loc,term)
+  | GrafiteAst.Decompose (loc, types, what, names) ->
+      let disambiguate (status, types) = function
+         | GrafiteAst.Type _   -> assert false
+        | GrafiteAst.Ident id ->
+           match disambiguate_term status (CicNotationPt.Ident (id, None)) with
+              | status, Cic.MutInd (uri, tyno, _) ->
+                 status, (GrafiteAst.Type (uri, tyno) :: types)
+               | _                                 -> 
+                 raise Disambiguate.NoWellTypedInterpretation
+      in
+      let status, types = List.fold_left disambiguate (status, []) types in
+      status, GrafiteAst.Decompose(loc, types, what, names)  
   | GrafiteAst.Discriminate (loc,term) ->
       let status,term = disambiguate_term status term in
       status, GrafiteAst.Discriminate(loc,term)
@@ -480,12 +501,12 @@ let disambiguate_command status = function
       let status,obj = disambiguate_obj status obj in
        status, GrafiteAst.Obj (loc,obj)
 
-let try_open_in paths path =
+let try_open_in ~f paths path =
   let rec aux = function
-  | [] -> open_in path
+  | [] -> f path
   | p :: tl ->
       try
-        open_in (p ^ "/" ^ path)
+        f (p ^ "/" ^ path)
       with Sys_error _ -> aux tl
   in
   try
@@ -510,14 +531,14 @@ let eval_command opts status cmd =
         (GrafiteAstPp.pp_command cmd ^ "\n") :: status.moo_content_rev}
   | GrafiteAst.Include (loc, path) ->
      let path = MatitaMisc.obj_file_of_script path in
-     let stream = 
-       try
-         Stream.of_channel (try_open_in opts.include_paths path) 
-       with Sys_error _ -> raise (UnableToInclude path)
-     in
-     let status = ref status in
-      !eval_from_stream_ref status stream (fun _ _ -> ());
-      !status
+     (try
+       let ic = try_open_in ~f:open_in opts.include_paths path in
+       let stream = Stream.of_channel ic in
+       let status = ref status in
+       !eval_from_stream_ref status stream (fun _ _ -> ());
+       close_in ic;
+       !status
+     with Sys_error _ -> raise (UnableToInclude path))
   | GrafiteAst.Set (loc, name, value) -> 
       let value = 
         if name = "baseuri" then
@@ -529,6 +550,15 @@ let eval_command opts status cmd =
         else
           value
       in
+      if not (MatitacleanLib.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 ->
@@ -572,7 +602,9 @@ let eval_command opts status cmd =
   | GrafiteAst.Render _ -> assert false (* ZACK: to be removed *)
   | GrafiteAst.Dump _ -> assert false   (* ZACK: to be removed *)
   | GrafiteAst.Interpretation _
-  | GrafiteAst.Notation _ -> status
+  | GrafiteAst.Notation _ as stm ->
+      { status with moo_content_rev =
+        (GrafiteAstPp.pp_command stm ^ "\n") :: status.moo_content_rev }
   | GrafiteAst.Obj (loc,obj) ->
      let ext,name =
       match obj with
@@ -595,6 +627,12 @@ let eval_command opts status cmd =
            begin
              let dbd = MatitaDb.instance () in
              let similar = MetadataQuery.match_term ~dbd ty in
+             let similar_len = List.length similar in
+             if similar_len> 30 then
+               (MatitaLog.message
+                 ("Duplicate check will compare your theorem with " ^ 
+                   string_of_int similar_len ^ 
+                   " theorems, this may take a while."));
              let convertible =
                List.filter (
                  fun u ->
@@ -652,39 +690,47 @@ let eval_executable opts status ex =
 let eval_comment status c = status
             
 
-let eval_ast ?(do_heavy_checks=false) ?(include_paths=[]) status st =
-  let opts = 
-    {do_heavy_checks = do_heavy_checks ; include_paths = include_paths}
+let eval_ast 
+  ?(do_heavy_checks=false) ?(include_paths=[]) ?(clean_baseuri=true) status st 
+=
+  let opts = {
+    do_heavy_checks = do_heavy_checks ; 
+    include_paths = include_paths;
+    clean_baseuri = clean_baseuri }
   in
   match st with
   | GrafiteAst.Executable (_,ex) -> eval_executable opts status ex
   | GrafiteAst.Comment (_,c) -> eval_comment status c
 
-let eval_from_stream ?do_heavy_checks ?include_paths status str cb =
+let eval_from_stream 
+  ?do_heavy_checks ?include_paths ?clean_baseuri status str cb 
+=
   try
     while true do
       let ast = GrafiteParser.parse_statement str in
       cb !status ast;
-      status := eval_ast ?do_heavy_checks ?include_paths !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_stream_greedy ?do_heavy_checks ?include_paths status str cb =
+let eval_from_stream_greedy 
+  ?do_heavy_checks ?include_paths ?clean_baseuri status str cb 
+=
   while true do
     print_string "matita> ";
     flush stdout;
     let ast = GrafiteParser.parse_statement str in
     cb !status ast;
-    status := eval_ast ?do_heavy_checks ?include_paths !status ast 
+    status := eval_ast ?do_heavy_checks ?include_paths ?clean_baseuri !status ast 
   done
 ;;
 
-let eval_string ?do_heavy_checks ?include_paths status str =
+let eval_string ?do_heavy_checks ?include_paths ?clean_baseuri status str =
   eval_from_stream 
-    ?do_heavy_checks ?include_paths status (Stream.of_string str) (fun _ _ ->())
+    ?do_heavy_checks ?include_paths ?clean_baseuri status (Stream.of_string str) (fun _ _ ->())
 
 let default_options () =
 (*