]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/matita/matitaScript.ml
removed no longer used METAs
[helm.git] / helm / matita / matitaScript.ml
index a0d0944ca0c8d770375b8395db59c6a211225b54..188726d9510879720ff984782cd5d8e26fe558d6 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
@@ -79,21 +80,7 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
  parsed_text st
 =
   let module TAPp = GrafiteAstPp in
-  let include_ = 
-    match guistuff.filenamedata with
-    | None,None -> []
-    | None,Some devel -> [MatitamakeLib.root_for_development devel ]
-    | Some f,_ -> 
-        match MatitamakeLib.development_for_dir (Filename.dirname f) with
-        | None -> []
-        | Some devel -> [MatitamakeLib.root_for_development devel ]
-  in
-  let include_ =
-    include_ @ (Helm_registry.get_list Helm_registry.string "matita.includes")
-  in
   let parsed_text_length = String.length parsed_text in
-  let loc, ex = 
-    match st with TA.Executable (loc,ex) -> loc, ex | _ -> assert false in
   let initial_space,parsed_text =
    try
     let pieces = Pcre.extract ~rex:heading_nl_RE' parsed_text in
@@ -103,7 +90,9 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
   let inital_space,new_grafite_status,new_lexicon_status,new_status_and_text_list' =
    (* the code commented out adds the "select" command if needed *)
    initial_space,grafite_status,lexicon_status,[] in
-(*    match grafite_status.proof_status with
+(* let loc, ex = 
+    match st with TA.Executable (loc,ex) -> loc, ex | _ -> assert false in
+    match grafite_status.proof_status with
      | Incomplete_proof { stack = stack }
       when not (List.mem user_goal (Continuationals.head_goals stack)) ->
         let grafite_status =
@@ -152,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
@@ -210,12 +196,20 @@ 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
     ~lazy_term_pp:(fun _ -> assert false) ~obj_pp:(fun _ -> assert false)
  
-let rec eval_macro (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script mac =
+let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script mac =
   let module TAPp = GrafiteAstPp in
   let module MQ = MetadataQuery in
   let module MDB = LibraryDb in
@@ -290,8 +284,8 @@ let rec eval_macro (buffer : GText.buffer) guistuff lexicon_status grafite_statu
           let loc = HExtlib.floc_of_loc (0,text_len) in
           let statement = `Ast (GrafiteParser.LSome (ast loc),text) in
           let res,_parsed_text_len =
-           eval_statement buffer guistuff lexicon_status grafite_status
-            user_goal script statement
+           eval_statement include_paths buffer guistuff lexicon_status
+            grafite_status user_goal script statement
           in
            (* we need to replace all the parsed_text *)
            res,String.length parsed_text
@@ -318,7 +312,7 @@ let rec eval_macro (buffer : GText.buffer) guistuff lexicon_status grafite_statu
   | TA.Search_pat (_, search_kind, str) -> failwith "not implemented"
   | TA.Search_term (_, search_kind, term) -> failwith "not implemented"
                                 
-and eval_executable (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script loc ex
+and eval_executable include_paths (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script loc ex
 =
  let module TAPp = GrafiteAstPp in
  let module MD = GrafiteDisambiguator in
@@ -354,20 +348,22 @@ and eval_executable (buffer : GText.buffer) guistuff lexicon_status grafite_stat
           None -> []
         | Some n -> GrafiteTypes.get_proof_context grafite_status n in
       let grafite_status,macro = lazy_macro context in
-       eval_macro buffer guistuff lexicon_status grafite_status user_goal
-        unparsed_text parsed_text script macro
+       eval_macro include_paths buffer guistuff lexicon_status grafite_status
+        user_goal unparsed_text parsed_text script macro
 
-and eval_statement (buffer : GText.buffer) guistuff lexicon_status
+and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
  grafite_status user_goal script statement
 =
   let (lexicon_status,st), unparsed_text =
     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:(Helm_registry.get_list
-           Helm_registry.string "matita.includes")
-         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 =
@@ -386,8 +382,8 @@ and eval_statement (buffer : GText.buffer) guistuff lexicon_status
       let s = String.sub unparsed_text parsed_text_length remain_len in
       let s,len = 
        try
-        eval_statement buffer guistuff lexicon_status grafite_status user_goal
-         script (`Raw s)
+        eval_statement include_paths buffer guistuff lexicon_status
+         grafite_status user_goal script (`Raw s)
        with
           HExtlib.Localized (floc, exn) ->
            HExtlib.raise_localized_exception ~offset:parsed_text_length floc exn
@@ -402,8 +398,8 @@ and eval_statement (buffer : GText.buffer) guistuff lexicon_status
       | [] -> [], 0)
   | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) ->
      let parsed_text, parsed_text_length = text_of_loc loc in
-      eval_executable buffer guistuff lexicon_status grafite_status user_goal
-       unparsed_text parsed_text script loc ex
+      eval_executable include_paths buffer guistuff lexicon_status
+       grafite_status user_goal unparsed_text parsed_text script loc ex
   
 let fresh_script_id =
   let i = ref 0 in
@@ -419,6 +415,7 @@ class script  ~(source_view: GSourceView.source_view)
 let buffer = source_view#buffer in
 let source_buffer = source_view#source_buffer in
 let initial_statuses =
+ (* these include_paths are used only to load the initial notation *)
  let include_paths =
   Helm_registry.get_list Helm_registry.string "matita.includes" in
  let lexicon_status =
@@ -428,6 +425,9 @@ let initial_statuses =
   grafite_status,lexicon_status
 in
 object (self)
+  val mutable include_paths =
+   Helm_registry.get_list Helm_registry.string "matita.includes"
+
   val scriptId = fresh_script_id ()
   
   val guistuff = {
@@ -484,8 +484,8 @@ object (self)
    HLog.debug ("evaluating: " ^ first_line s ^ " ...");
    let (entries, parsed_len) = 
     try
-     eval_statement buffer guistuff self#lexicon_status self#grafite_status
-      userGoal self (`Raw s)
+     eval_statement include_paths buffer guistuff self#lexicon_status
+      self#grafite_status userGoal self (`Raw s)
     with End_of_file -> raise Margin
    in
    let new_statuses, new_statements =
@@ -509,7 +509,9 @@ object (self)
       bottom) and we will face a macro *)
    match self#grafite_status.proof_status with
       Incomplete_proof p ->
-       userGoal <- Some (Continuationals.Stack.find_goal p.stack)
+       userGoal <-
+         (try Some (Continuationals.Stack.find_goal p.stack)
+         with Failure _ -> None)
     | _ -> userGoal <- None
 
   method private _retract offset lexicon_status grafite_status new_statements
@@ -598,8 +600,17 @@ object (self)
     
   method assignFileName file =
     let abspath = MatitaMisc.absolute_path file in
-    let devel = MatitamakeLib.development_for_dir (Filename.dirname abspath) in
-    guistuff.filenamedata <- Some abspath, devel
+    let dirname = Filename.dirname abspath in
+    let devel = MatitamakeLib.development_for_dir dirname in
+    guistuff.filenamedata <- Some abspath, devel;
+    let include_ = 
+     match MatitamakeLib.development_for_dir dirname with
+        None -> []
+      | Some devel -> [MatitamakeLib.root_for_development devel] in
+    let include_ =
+     include_ @ (Helm_registry.get_list Helm_registry.string "matita.includes")
+    in
+     include_paths <- include_
     
   method saveToFile () =
     let oc = open_out self#getFilename in
@@ -650,10 +661,19 @@ object (self)
   method template () =
     let template = HExtlib.input_file BuildTimeConf.script_template in 
     buffer#insert ~iter:(buffer#get_iter `START) template;
-    guistuff.filenamedata <- 
-      (None,MatitamakeLib.development_for_dir (Unix.getcwd ()));
-    buffer#set_modified false;
-    set_star (Filename.basename self#ppFilename) false
+    let development = MatitamakeLib.development_for_dir (Unix.getcwd ()) in
+    guistuff.filenamedata <- (None,development);
+    let include_ = 
+     match development with
+        None -> []
+      | Some devel -> [MatitamakeLib.root_for_development devel ]
+    in
+    let include_ =
+     include_ @ (Helm_registry.get_list Helm_registry.string "matita.includes")
+    in
+     include_paths <- include_ ;
+     buffer#set_modified false;
+     set_star (Filename.basename self#ppFilename) false
 
   method goto (pos: [`Top | `Bottom | `Cursor]) () =
     let old_locked_mark =
@@ -747,9 +767,8 @@ object (self)
 
   method proofContext =
    match userGoal with
-      None -> assert false
-    | Some n ->
-       GrafiteTypes.get_proof_context self#grafite_status n
+      None -> []
+    | Some n -> GrafiteTypes.get_proof_context self#grafite_status n
 
   method proofConclusion =
    match userGoal with
@@ -758,30 +777,28 @@ object (self)
        GrafiteTypes.get_proof_conclusion self#grafite_status n
 
   method stack = GrafiteTypes.get_stack self#grafite_status
-  method setGoal n = userGoal <- Some n
+  method setGoal n = userGoal <- n
   method goal = userGoal
 
   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:(Helm_registry.get_list
-          Helm_registry.string "matita.includes")
-        lexicon_status
+        ~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