]> matita.cs.unibo.it Git - helm.git/commitdiff
fixed coercions undoooing
authorEnrico Tassi <enrico.tassi@inria.fr>
Thu, 12 Jan 2006 15:46:34 +0000 (15:46 +0000)
committerEnrico Tassi <enrico.tassi@inria.fr>
Thu, 12 Jan 2006 15:46:34 +0000 (15:46 +0000)
helm/matita/matitaGui.ml
helm/matita/matitaScript.ml
helm/matita/matitaScript.mli
helm/ocaml/grafite_engine/grafiteEngine.ml
helm/ocaml/lexicon/lexiconEngine.mli
helm/ocaml/library/librarySync.ml
helm/ocaml/tactics/paramodulation/Makefile

index 03e50588f4b98cea91c45a1d39ade776440f2b64..ed739eefbebb8c9be4a9e5ab95f919166625a722 100644 (file)
@@ -607,7 +607,9 @@ class gui () =
         (* log *)
       HLog.set_log_callback self#console#log_callback;
       GtkSignal.user_handler :=
-        (fun exn ->
+        (function 
+        | MatitaScript.ActionCancelled -> () 
+        | exn ->
           if not (Helm_registry.get_bool "matita.debug") then
            let floc, msg = MatitaExcPp.to_string exn in
             begin
index 4c53f113bd9d0db4b7707d628a320be84f00dee8..4b1b994d97f8e01b22278d1a787fd084da688be1 100644 (file)
@@ -36,6 +36,7 @@ let debug_print = if debug then prerr_endline else ignore
   (** raised when one of the script margins (top or bottom) is reached *)
 exception Margin
 exception NoUnfinishedProof
+exception ActionCancelled
 
 let safe_substring s i j =
   try String.sub s i j with Invalid_argument _ -> assert false
@@ -140,27 +141,24 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
    in
     res,parsed_text_length
 
-let eval_with_engine
-     guistuff lexicon_status grafite_status user_goal parsed_text st
-=
-  try
-   eval_with_engine guistuff lexicon_status grafite_status user_goal parsed_text
-    st
+let wrap_with_developments guistuff f arg = 
+  try 
+    f arg
   with
   | DependenciesParser.UnableToInclude what 
+  | LexiconEngine.IncludedFileNotCompiled what 
   | GrafiteEngine.IncludedFileNotCompiled what as exc ->
       let compile_needed_and_go_on d =
-        let target = what in
+        let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" what in
         let refresh_cb () = 
           while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
         in
         if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
           raise exc
         else
-         eval_with_engine guistuff lexicon_status grafite_status user_goal
-          parsed_text st
+          f arg
       in
-      let do_nothing () = [], 0 in
+      let do_nothing () = raise ActionCancelled in
       let handle_with_devel d =
         let name = MatitamakeLib.name_for_development d in
         let title = "Unable to include " ^ what in
@@ -198,6 +196,14 @@ let eval_with_engine
           | None -> handle_without_devel (Some f)
           | Some d -> handle_with_devel d
 ;;
+    
+let eval_with_engine
+     guistuff lexicon_status grafite_status user_goal parsed_text st
+=
+  wrap_with_developments guistuff
+    (eval_with_engine 
+      guistuff lexicon_status grafite_status user_goal parsed_text) st
+;;
 
 let pp_eager_statement_ast =
   GrafiteAstPp.pp_statement ~term_pp:CicNotationPp.pp_term
@@ -352,8 +358,12 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
     match statement with
     | `Raw text ->
         if Pcre.pmatch ~rex:only_dust_RE text then raise Margin;
-        GrafiteParser.parse_statement (Ulexing.from_utf8_string text)
-         ~include_paths lexicon_status, text
+        let ast = 
+          wrap_with_developments guistuff
+            (GrafiteParser.parse_statement 
+              (Ulexing.from_utf8_string text) ~include_paths) lexicon_status 
+        in
+          ast, text
     | `Ast (st, text) -> (lexicon_status, st), text
   in
   let text_of_loc loc =
@@ -770,23 +780,23 @@ object (self)
 
   method eos = 
     let s = self#getFuture in
-    let rec is_there_and_executable lexicon_status s = 
+    let rec is_there_only_comments lexicon_status s = 
       if Pcre.pmatch ~rex:only_dust_RE s then raise Margin;
       let lexicon_status,st =
        GrafiteParser.parse_statement (Ulexing.from_utf8_string s)
         ~include_paths lexicon_status
       in
       match st with
-        GrafiteParser.LNone loc
       | GrafiteParser.LSome (GrafiteAst.Comment (loc,_)) -> 
           let parsed_text_length = snd (HExtlib.loc_of_floc loc) in
           let remain_len = String.length s - parsed_text_length in
           let next = String.sub s parsed_text_length remain_len in
-          is_there_and_executable lexicon_status next
-      | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) -> false
+          is_there_only_comments lexicon_status next
+      | GrafiteParser.LNone _
+      | GrafiteParser.LSome (GrafiteAst.Executable _) -> false
     in
     try
-      is_there_and_executable self#lexicon_status s
+      is_there_only_comments self#lexicon_status s
     with 
     | CicNotationParser.Parse_error _ -> false
     | Margin | End_of_file -> true
index 8eb6d8dd9afc0d44596d6bde9c696a0c0249d033..cfc4655414bc08acaca2528aa175fa93c85a8da6 100644 (file)
@@ -24,6 +24,7 @@
  *)
 
 exception NoUnfinishedProof
+exception ActionCancelled
 
 class type script =
 object
index 60b2b6a9dbe08935058edbd75244ec0854d7aa17..65dd17b6a096c1e144daf7068e80cf49cba2ce2d 100644 (file)
@@ -397,6 +397,7 @@ let coercion_moo_statement_of uri =
 let eval_coercion status ~add_composites uri =
  let basedir = Helm_registry.get "matita.basedir" in
  let status,compounds =
+   prerr_endline "evaluating a coercion command";
   GrafiteSync.add_coercion ~basedir ~add_composites status uri in
  let moo_content = coercion_moo_statement_of uri in
  let status = GrafiteTypes.add_moo_content [moo_content] status in
@@ -522,18 +523,14 @@ let add_coercions_of_record_to_moo obj lemmas status =
                 None) 
             lemmas)
       in
+      prerr_endline "actual coercions:";
       List.iter 
         (fun u -> prerr_endline (UriManager.string_of_uri u)) 
         coercions;
-      let status = GrafiteTypes.add_moo_content moo_content status in
-      let basedir = Helm_registry.get "matita.basedir" in
-      List.fold_left 
-        (fun (status,lemmas) uri ->
-          let status,new_lemmas =
-           GrafiteSync.add_coercion ~basedir ~add_composites:true status uri
-          in
-           status,new_lemmas@lemmas
-        ) (status,[]) coercions
+      let status = GrafiteTypes.add_moo_content moo_content status in 
+      {status with 
+        GrafiteTypes.coercions = coercions @ status.GrafiteTypes.coercions}, 
+      lemmas
 
 let add_obj uri obj status =
  let basedir = Helm_registry.get "matita.basedir" in
index a2232fe288208da1910fd9baffa28ca674ec029f..ba09386402cd110b437d8d95437b8c8b8e413ab0 100644 (file)
@@ -23,6 +23,7 @@
  * http://helm.cs.unibo.it/
  *)
 
+exception IncludedFileNotCompiled of string
 
 type status = {
   aliases: DisambiguateTypes.environment;         (** disambiguation aliases *)
index 922955aa0af384c3e16716c8942c2097d225426a..abb50f36351b3ca4c641d1440105d40f5732821b 100644 (file)
@@ -50,7 +50,7 @@ let merge_coercions obj =
         C.Lambda (name, aux so, aux dest)
     | C.LetIn (name,so,dest) -> 
         C.LetIn (name, aux so, aux dest)
-    | (Cic.Appl [ c1 ; (Cic.Appl [c2; head]) ]) when 
+    | Cic.Appl [ c1 ; (Cic.Appl [c2; head]) ] when 
       CoercGraph.is_a_coercion c1 && CoercGraph.is_a_coercion c2 ->
         let source_carr = CoercGraph.source_of c2 in
         let tgt_carr = CoercGraph.target_of c1 in
@@ -308,6 +308,9 @@ let add_coercion ~basedir ~add_composites uri =
   in
   (* store that composite_uris are related to uri. the first component is the
    * stuff in the DB while the second is stuff for remove_obj *)
+  prerr_endline ("aggiungo: " ^ string_of_bool add_composites ^ UriManager.string_of_uri uri);
+  List.iter (fun u -> prerr_endline (UriManager.string_of_uri u))
+      composite_uris;
   UriManager.UriHashtbl.add coercion_hashtbl uri 
     (composite_uris,if add_composites then composite_uris else []);
   lemmas
@@ -317,6 +320,9 @@ let remove_coercion uri =
     let (composites_in_db, composites_in_lib) = 
       UriManager.UriHashtbl.find coercion_hashtbl uri 
     in
+    prerr_endline ("removing: " ^UriManager.string_of_uri uri);
+    List.iter (fun u -> prerr_endline (UriManager.string_of_uri u))
+      composites_in_db;
     UriManager.UriHashtbl.remove coercion_hashtbl uri;
     CoercDb.remove_coercion (fun (_,_,u) -> UriManager.eq uri u);
     (* remove from the DB *) 
@@ -340,7 +346,6 @@ let generate_projections ~basedir uri fields =
          CicTypeChecker.type_of_aux' [] [] bo CicUniv.empty_ugraph in
        let attrs = [`Class `Projection; `Generated] in
        let obj = Cic.Constant (name,Some bo,ty,[],attrs) in
-       
         add_single_obj ~basedir uri obj;
         let composites = 
          if coercion then
index 467def96946914d38f878dc11cf3fe97b1d0b8fb..880b959533c805b0a539c52a2b5cf6595cf2bb05 100644 (file)
@@ -4,8 +4,8 @@ LOCALLINKOPTS = -package helm-cic_disambiguation,helm-content_pres,helm-grafite,
 
 include ../../Makefile.common
 
-all:saturate
-opt:saturate.opt
+all $(PACKAGE).cma :saturate 
+opt $(PACKAGE).cmxa:saturate.opt
 
 saturate: saturate_main.ml $(LIBRARIES)
        $(OCAMLC) $(LOCALLINKOPTS) -thread -linkpkg -o $@ $<