X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Fgrafite_engine%2FgrafiteEngine.ml;h=8b83bcff0fcf3569af351757165b11b88cd3dfbc;hb=883c1c82973b96587eeee6461b0bc838f8572e22;hp=bea1ec74e14e9e7f563a8a9dc868289ba8062b5f;hpb=530de41857abad18eaa18e3f53d1396ebe86cb22;p=helm.git

diff --git a/components/grafite_engine/grafiteEngine.ml b/components/grafite_engine/grafiteEngine.ml
index bea1ec74e..8b83bcff0 100644
--- a/components/grafite_engine/grafiteEngine.ml
+++ b/components/grafite_engine/grafiteEngine.ml
@@ -34,6 +34,8 @@ exception Macro of
   (Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
 exception ReadOnlyUri of string
 
+type 'a disambiguator_input = string * int * 'a
+
 type options = { 
   do_heavy_checks: bool ; 
   clean_baseuri: bool
@@ -275,13 +277,13 @@ let reorder_metasenv start refine tactic goals current_goal always_opens_a_goal=
 |+   FINE DEBUG CODE +| *)
   before @ produced_metas @ after, goals 
   
-let apply_tactic ~disambiguate_tactic tactic (status, goal) =
+let apply_tactic ~disambiguate_tactic (text,prefix_len,tactic) (status, goal) =
 (* prerr_endline "apply_tactic"; *)
 (* prerr_endline (Continuationals.Stack.pp (GrafiteTypes.get_stack status)); *)
  let starting_metasenv = GrafiteTypes.get_proof_metasenv status in
  let before = List.map (fun g, _, _ -> g) starting_metasenv in
 (* prerr_endline "disambiguate"; *)
- let status, tactic = disambiguate_tactic status goal tactic in
+ let status, tactic = disambiguate_tactic status goal (text,prefix_len,tactic) in
  let metasenv_after_refinement =  GrafiteTypes.get_proof_metasenv status in
  let proof = GrafiteTypes.get_current_proof status in
  let proof_status = proof, goal in
@@ -330,34 +332,36 @@ type eval_ast =
   disambiguate_tactic:
    (GrafiteTypes.status ->
     ProofEngineTypes.goal ->
-    ('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic ->
+    (('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic)
+    disambiguator_input ->
     GrafiteTypes.status *
    (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) GrafiteAst.tactic) ->
 
   disambiguate_command:
    (GrafiteTypes.status ->
-    'obj GrafiteAst.command ->
+    ('obj GrafiteAst.command) disambiguator_input ->
     GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
 
   disambiguate_macro:
    (GrafiteTypes.status ->
-    'term GrafiteAst.macro ->
+    ('term GrafiteAst.macro) disambiguator_input ->
     Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
 
   ?do_heavy_checks:bool ->
   ?clean_baseuri:bool ->
   GrafiteTypes.status ->
-  ('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.statement ->
+  (('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.statement)
+  disambiguator_input ->
   GrafiteTypes.status * UriManager.uri list
  }
 
 type 'a eval_command =
  {ec_go: 'term 'obj.
   disambiguate_command:
-   (GrafiteTypes.status ->
-    'obj GrafiteAst.command ->
-    GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
-  options -> GrafiteTypes.status -> 'obj GrafiteAst.command ->
+   (GrafiteTypes.status -> ('obj GrafiteAst.command) disambiguator_input ->
+    GrafiteTypes.status * Cic.obj GrafiteAst.command) -> 
+  options -> GrafiteTypes.status -> 
+    ('obj GrafiteAst.command) disambiguator_input ->
    GrafiteTypes.status * UriManager.uri list
  }
 
@@ -366,23 +370,24 @@ type 'a eval_executable =
   disambiguate_tactic:
    (GrafiteTypes.status ->
     ProofEngineTypes.goal ->
-    ('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic ->
+    (('term, 'lazy_term, 'reduction, 'ident) GrafiteAst.tactic)
+    disambiguator_input ->
     GrafiteTypes.status *
    (Cic.term, Cic.lazy_term, Cic.lazy_term GrafiteAst.reduction, string) GrafiteAst.tactic) ->
 
   disambiguate_command:
    (GrafiteTypes.status ->
-    'obj GrafiteAst.command ->
+    ('obj GrafiteAst.command) disambiguator_input ->
     GrafiteTypes.status * Cic.obj GrafiteAst.command) ->
 
   disambiguate_macro:
    (GrafiteTypes.status ->
-    'term GrafiteAst.macro ->
+    ('term GrafiteAst.macro) disambiguator_input ->
     Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
 
   options ->
   GrafiteTypes.status ->
-  ('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.code ->
+  (('term, 'lazy_term, 'reduction, 'obj, 'ident) GrafiteAst.code) disambiguator_input ->
   GrafiteTypes.status * UriManager.uri list
  }
 
@@ -416,10 +421,8 @@ let refinement_toolkit = {
  }
   
 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 refinement_toolkit status uri in
+  GrafiteSync.add_coercion ~add_composites refinement_toolkit status uri in
  let moo_content = coercion_moo_statement_of uri in
  let status = GrafiteTypes.add_moo_content [moo_content] status in
   {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},
@@ -436,7 +439,7 @@ let eval_tactical ~disambiguate_tactic status tac =
  
    type tactic = input_status -> output_status
  
-   let id_tactic = apply_tactic (GrafiteAst.IdTac HExtlib.dummy_floc)
+   let id_tactic = apply_tactic ("",0,(GrafiteAst.IdTac HExtlib.dummy_floc))
    let mk_tactic tac = tac
    let apply_tactic tac = tac
    let goals (_, opened, closed) = opened, closed
@@ -451,7 +454,9 @@ let eval_tactical ~disambiguate_tactic status tac =
   end
  in
  let module MatitaTacticals = Tacticals.Make (MatitaStatus) in
-  let rec tactical_of_ast l tac =
+  let rec tactical_of_ast l (text,prefix_len,tac) =
+    let apply_tactic t = apply_tactic (text, prefix_len, t) in
+    let tactical_of_ast l t = tactical_of_ast l (text,prefix_len,t) in
     match tac with
     | GrafiteAst.Tactic (loc, tactic) ->
         MatitaTacticals.tactic (MatitaStatus.mk_tactic (apply_tactic tactic))
@@ -555,22 +560,29 @@ let add_coercions_of_record_to_moo obj lemmas status =
       lemmas
 
 let add_obj uri obj status =
- let basedir = Helm_registry.get "matita.basedir" in
- let status,lemmas = GrafiteSync.add_obj ~basedir refinement_toolkit uri obj status in
+ let status,lemmas = GrafiteSync.add_obj refinement_toolkit uri obj status in
  status, lemmas 
       
-let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
- let status,cmd = disambiguate_command status cmd in
- let basedir = Helm_registry.get "matita.basedir" in
+let rec eval_command = {ec_go = fun ~disambiguate_command opts status
+(text,prefix_len,cmd) ->
+ let status,cmd = disambiguate_command status (text,prefix_len,cmd) in
  let status,uris =
   match cmd with
   | GrafiteAst.Default (loc, what, uris) as cmd ->
      LibraryObjects.set_default what uris;
      GrafiteTypes.add_moo_content [cmd] status,[]
   | GrafiteAst.Include (loc, baseuri) ->
-     let moopath = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
-     if not (Sys.file_exists moopath) then
-       raise (IncludedFileNotCompiled moopath);
+     let moopath_rw, moopath_r = 
+       LibraryMisc.obj_file_of_baseuri 
+         ~must_exist:false ~baseuri ~writable:true,
+       LibraryMisc.obj_file_of_baseuri 
+         ~must_exist:false ~baseuri ~writable:false
+     in
+     let moopath = 
+       if Sys.file_exists moopath_r then moopath_r else
+         if Sys.file_exists moopath_rw then moopath_rw else
+           raise (IncludedFileNotCompiled moopath_rw)
+     in
      let status = eval_from_moo.efm_go status moopath in
      status,[]
   | GrafiteAst.Set (loc, name, value) -> 
@@ -586,11 +598,17 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
           HLog.error (sprintf "uri %s belongs to a read-only repository" value);
           raise (ReadOnlyUri value)
         end;
-        if not (GrafiteMisc.is_empty value) && opts.clean_baseuri then begin
+        if not (Http_getter_storage.is_empty value) && 
+           opts.clean_baseuri 
+          then begin
           HLog.message ("baseuri " ^ value ^ " is not empty");
           HLog.message ("cleaning baseuri " ^ value);
-          LibraryClean.clean_baseuris ~basedir [value];
+          LibraryClean.clean_baseuris [value];
+          assert (Http_getter_storage.is_empty value);
         end;
+        HExtlib.mkdir 
+          (Filename.dirname (Http_getter.filename ~writable:true (value ^
+            "/foo.con")));
       end;
       GrafiteTypes.set_option status name value,[]
   | GrafiteAst.Drop loc -> raise Drop
@@ -664,8 +682,8 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
                  ("Theorem already proved: " ^ UriManager.string_of_uri x ^ 
                   "\nPlease use a variant."));
            end;
-         let initial_proof = (Some uri, metasenv, bo, ty) in
-         let initial_stack = Continuationals.Stack.of_metasenv metasenv in
+         let initial_proof = (Some uri, metasenv', bo, ty) in
+         let initial_stack = Continuationals.Stack.of_metasenv metasenv' in
          { status with GrafiteTypes.proof_status =
             GrafiteTypes.Incomplete_proof
              { GrafiteTypes.proof = initial_proof; stack = initial_stack } },
@@ -687,23 +705,25 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
       {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},uris
    | _ -> status,uris
 
-} and eval_executable = {ee_go = fun ~disambiguate_tactic ~disambiguate_command ~disambiguate_macro opts status ex ->
+} and eval_executable = {ee_go = fun ~disambiguate_tactic ~disambiguate_command
+~disambiguate_macro opts status (text,prefix_len,ex) ->
   match ex with
   | GrafiteAst.Tactical (_, tac, None) ->
-     eval_tactical ~disambiguate_tactic status tac,[]
+     eval_tactical ~disambiguate_tactic status (text,prefix_len,tac),[]
   | GrafiteAst.Tactical (_, tac, Some punct) ->
-     let status = eval_tactical ~disambiguate_tactic status tac in
-      eval_tactical ~disambiguate_tactic status punct,[]
+     let status = 
+       eval_tactical ~disambiguate_tactic status (text,prefix_len,tac) in
+      eval_tactical ~disambiguate_tactic status (text,prefix_len,punct),[]
   | GrafiteAst.Command (_, cmd) ->
-      eval_command.ec_go ~disambiguate_command opts status cmd
+      eval_command.ec_go ~disambiguate_command opts status (text,prefix_len,cmd)
   | GrafiteAst.Macro (loc, macro) ->
-     raise (Macro (loc,disambiguate_macro status macro))
+     raise (Macro (loc,disambiguate_macro status (text,prefix_len,macro)))
 
 } and eval_from_moo = {efm_go = fun status fname ->
   let ast_of_cmd cmd =
-    GrafiteAst.Executable (HExtlib.dummy_floc,
+    ("",0,GrafiteAst.Executable (HExtlib.dummy_floc,
       GrafiteAst.Command (HExtlib.dummy_floc,
-        cmd))
+        cmd)))
   in
   let moo = GrafiteMarshal.load_moo fname in
   List.fold_left 
@@ -711,15 +731,17 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
       let ast = ast_of_cmd ast in
       let status,lemmas =
        eval_ast.ea_go
-         ~disambiguate_tactic:(fun status _ tactic -> status,tactic)
-         ~disambiguate_command:(fun status cmd -> status,cmd)
+         ~disambiguate_tactic:(fun status _ (_,_,tactic) -> status,tactic)
+         ~disambiguate_command:(fun status (_,_,cmd) -> status,cmd)
          ~disambiguate_macro:(fun _ _ -> assert false)
          status ast
       in
        assert (lemmas=[]);
        status)
     status moo
-} and eval_ast = {ea_go = fun ~disambiguate_tactic ~disambiguate_command ~disambiguate_macro ?(do_heavy_checks=false) ?(clean_baseuri=true) status st 
+} and eval_ast = {ea_go = fun ~disambiguate_tactic ~disambiguate_command
+~disambiguate_macro ?(do_heavy_checks=false) ?(clean_baseuri=true) status
+(text,prefix_len,st)
 ->
   let opts = {
     do_heavy_checks = do_heavy_checks ; 
@@ -728,8 +750,8 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
   match st with
   | GrafiteAst.Executable (_,ex) ->
      eval_executable.ee_go ~disambiguate_tactic ~disambiguate_command
-      ~disambiguate_macro opts status ex
-  | GrafiteAst.Comment (_,c) -> eval_comment status c,[]
+      ~disambiguate_macro opts status (text,prefix_len,ex)
+  | GrafiteAst.Comment (_,c) -> eval_comment status (text,prefix_len,c),[]
 }
 
 let eval_ast = eval_ast.ea_go