unificatiom hints with premises

[helm.git] / helm / software / components / binaries / transcript / engine.ml

diff --git a/helm/software/components/binaries/transcript/engine.ml b/helm/software/components/binaries/transcript/engine.ml
index 7e561e9b0468412fa649ee0785aa58f019af00be..ccf07423f6dd5cc14b5af35f6ede71356a5bbc2f 100644 (file)
--- a/helm/software/components/binaries/transcript/engine.ml
+++ b/helm/software/components/binaries/transcript/engine.ml
@@ -23,13 +23,17 @@
  * http://cs.unibo.it/helm/.
  *)
 
-module R = Helm_registry
-module X = HExtlib
-module T = Types
-module G = Grafite
+module R  = Helm_registry
+module X  = HExtlib
+module T  = Types
+module G  = Grafite
+module HG = Http_getter
+
+module O = Options
 
 type script = {
-   name: string;
+   name    : string;
+   is_ma   : bool;
    contents: T.items
 }
 
@@ -44,6 +48,7 @@ type status = {
    output_path: string;
    input_type: string;
    output_type: T.output_kind;
+   includes: (string * string) list;
    coercions: (string * string) list;
    files: string list;
    requires: (string * string) list;
@@ -51,7 +56,7 @@ type status = {
 }
 
 let default_script = { 
-   name = ""; contents = []
+   name = ""; is_ma = false; contents = []
 }
 
 let default_scripts = 2
@@ -87,11 +92,14 @@ let set_requires st =
 let init () = 
    let transcript_dir = Filename.dirname Sys.argv.(0) in
    let default_registry = Filename.concat transcript_dir "transcript" in
-   load_registry default_registry
+   let matita_registry = Filename.concat !O.cwd "matita" in
+   load_registry default_registry;
+   load_registry matita_registry;
+   HG.init ()
 
-let make cwd registry =
+let make registry =
    let id x = x in
-   let get_coercions = R.get_list (R.pair id id) in 
+   let get_pairs = R.get_list (R.pair id id) in 
    let get_output_type key =
       match R.get_string key with
          | "procedural"  -> T.Procedural
@@ -110,14 +118,15 @@ let make cwd registry =
       output_path = R.get_string "package.output_path";
       input_type = R.get_string "package.input_type";
       output_type = get_output_type "package.output_type";
-      coercions = get_coercions "package.coercion";
+      includes = get_pairs "package.include";
+      coercions = get_pairs "package.coercion";
       files = [];
       requires = [];
       scripts = Array.make default_scripts default_script
    } in
    let st = {st with
-      heading_path = Filename.concat cwd st.heading_path;
-      output_path = Filename.concat cwd st.output_path;
+      heading_path = Filename.concat !O.cwd st.heading_path;
+      output_path = Filename.concat !O.cwd st.output_path;
    } in
    prerr_endline "reading file names ...";
    let st = set_files st in
@@ -134,20 +143,21 @@ let get_index st name =
       | Some i, _ | _, Some i -> i
       | None, None            -> failwith "not enought script entries"
 
+let is_ma st name =
+   let i = get_index st name in
+   let script = st.scripts.(i) in
+   st.scripts.(i) <- {script with is_ma = true}
+
 let set_items st name items =
    let i = get_index st name in
    let script = st.scripts.(i) in
    let contents = List.rev_append items script.contents in
-   st.scripts.(i) <- {name = name; contents = contents}
+   st.scripts.(i) <- {script with name = name; contents = contents}
    
 let set_heading st name =
    let heading = st.heading_path, st.heading_lines in
    set_items st name [T.Heading heading] 
    
-let set_baseuri st name =
-   let baseuri = Filename.concat st.output_base_uri name in
-   set_items st name [T.BaseUri baseuri]
-   
 let require st name inc =
    set_items st name [T.Include inc]
 
@@ -160,20 +170,24 @@ let make_path path =
 let make_prefix path =
    String.concat "__" (List.rev path) ^ "__"
 
+let make_script_name st script name = 
+   let ext = if script.is_ma then ".ma" else ".mma" in
+   Filename.concat st.output_path (name ^ ext)
+
 let commit st name =
    let i = get_index st name in
    let script = st.scripts.(i) in
    let path = Filename.concat st.output_path (Filename.dirname name) in
-   let name = Filename.concat st.output_path (name ^ ".ma") in
+   let name = make_script_name st script name in
    let cmd = Printf.sprintf "mkdir -p %s" path in
    let _ = Sys.command cmd in
    let och = open_out name in
    G.commit st.output_type och script.contents;
    close_out och;
-   st.scripts.(i) <-  default_script
-   
+   st.scripts.(i) <- default_script
+
 let produce st =
-   let init name = set_heading st name; set_baseuri st name in
+   let init name = set_heading st name in
    let partition = function 
       | T.Coercion (false, _)
       | T.Notation (false, _) -> false
@@ -183,13 +197,13 @@ let produce st =
       let in_base_uri = Filename.concat st.input_base_uri name in
       let out_base_uri = Filename.concat st.output_base_uri name in
       let filter path = function
-         | T.Inline (b, k, obj, p)      -> 
+         | T.Inline (b, k, obj, p, f)   -> 
            let obj, p = 
               if b then Filename.concat (make_path path) obj, make_prefix path
               else obj, p
            in 
            let s = obj ^ G.string_of_inline_kind k in
-           path, Some (T.Inline (b, k, Filename.concat in_base_uri s, p))
+           path, Some (T.Inline (b, k, Filename.concat in_base_uri s, p, f))
         | T.Include s                  ->
            begin 
               try path, Some (T.Include (List.assoc s st.requires))
@@ -206,6 +220,10 @@ let produce st =
            path, Some item
         | item                         -> path, Some item
       in
+      let set_includes st name =
+        try require st name (List.assoc name st.includes) 
+        with Not_found -> ()
+      in
       Printf.eprintf "processing file name: %s ...\n" name; flush stderr; 
       let file = Filename.concat st.input_path (name ^ st.input_type) in
       let ich = open_in file in
@@ -219,11 +237,12 @@ let produce st =
         let comment = T.Line (Printf.sprintf "From %s" name) in 
         if global_items <> [] then 
            set_items st st.input_package (comment :: global_items);
-        init name; require st name st.input_package;
+        init name; require st name st.input_package; set_includes st name;
         set_items st name local_items; commit st name
       with e -> 
          prerr_endline (Printexc.to_string e); close_in ich 
    in
+   is_ma st st.input_package;
    init st.input_package; require st st.input_package "preamble"; 
    List.iter (produce st) st.files; 
    commit st st.input_package