X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fbinaries%2Ftranscript%2Fengine.ml;h=66c6c33be85a2b53e16352a7c41b57e77ee2a8d0;hb=419b8fd3c58efbcc5de030ee6b164dc93c5d83db;hp=92c3c73b469c8b9138e0aebf8cd2d3cec29cb43b;hpb=c5e25191f05bb2662fc738bfb2742eb03b941510;p=helm.git

diff --git a/helm/software/components/binaries/transcript/engine.ml b/helm/software/components/binaries/transcript/engine.ml
index 92c3c73b4..66c6c33be 100644
--- a/helm/software/components/binaries/transcript/engine.ml
+++ b/helm/software/components/binaries/transcript/engine.ml
@@ -24,21 +24,27 @@
  *)
 
 module R = Helm_registry
+module X = HExtlib
+module T = Types
+module G = Grafite
 
 type script = {
    name: string;
-   contents: Types.items
+   contents: T.items
 }
 
 type status = {
    helm_dir: string;
    heading_path: string;
    heading_lines: int;
-   package: string;
-   base_uri: string;
+   input_package: string;
+   output_package: string;
+   input_base_uri: string;
+   output_base_uri: string;
    input_path: string;
    output_path: string;
    script_ext: string;
+   coercions: (string * string) list;
    files: string list;
    requires: (string * string) list;
    scripts: script array
@@ -83,16 +89,21 @@ let init () =
    load_registry default_registry
 
 let make registry =
+   let id x = x in
+   let get_coercions = R.get_list (R.pair id id) in 
    load_registry registry;
    let st = {
       helm_dir = R.get_string "transcript.helm_dir";
       heading_path = R.get_string "transcript.heading_path";
       heading_lines = R.get_int "transcript.heading_lines";
-      package = R.get_string "package.name";
-      base_uri = R.get_string "package.base_uri";
+      input_package = R.get_string "package.input_name";
+      output_package = R.get_string "package.output_name";
+      input_base_uri = R.get_string "package.input_base_uri";
+      output_base_uri = R.get_string "package.output_base_uri";
       input_path = R.get_string "package.input_path";
       output_path = R.get_string "package.output_path";
       script_ext = R.get_string "package.script_type";
+      coercions = get_coercions "package.coercion";
       files = [];
       requires = [];
       scripts = Array.make default_scripts default_script
@@ -120,12 +131,24 @@ let set_items st name items =
    
 let set_heading st name =
    let heading = Filename.concat st.helm_dir st.heading_path, st.heading_lines in
-   set_items st name [Types.Heading heading] 
+   set_items st name [T.Heading heading] 
    
 let set_baseuri st name =
-   let baseuri = Filename.concat st.base_uri name in
-   set_items st name [Types.BaseUri baseuri]
+   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]
+
+let get_coercion st str =
+   try List.assoc str st.coercions with Not_found -> ""
+
+let make_path path =
+   List.fold_left Filename.concat "" (List.rev path)
+
+let make_prefix path =
+   String.concat "__" (List.rev path) ^ "__"
+
 let commit st name =
    let i = get_index st name in
    let script = st.scripts.(i) in
@@ -134,22 +157,62 @@ let commit st name =
    let cmd = Printf.sprintf "mkdir -p %s" path in
    let _ = Sys.command cmd in
    let och = open_out name in
-   Grafite.commit och script.contents;
+   G.commit och script.contents;
    close_out och;
    st.scripts.(i) <-  default_script
    
 let produce st =
    let init name = set_heading st name; set_baseuri st name in
+   let partition = function 
+      | T.Coercion (false, _)
+      | T.Notation (false, _) -> false
+      | _                     -> true
+   in
    let produce st name =
+      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)      -> 
+	    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))
+	 | T.Include s                  ->
+	    begin 
+	       try path, Some (T.Include (List.assoc s st.requires))
+	       with Not_found -> path, None
+	    end
+	 | T.Coercion (b, obj)          ->
+	    let str = get_coercion st obj in
+	    if str <> "" then path, Some (T.Coercion (b, str)) else
+	    let base_uri = if b then out_base_uri else in_base_uri in
+	    let s = obj ^ G.string_of_inline_kind T.Con in
+	    path, Some (T.Coercion (b, Filename.concat base_uri s))
+	 | T.Section (b, id, _) as item ->
+	    let path = if b then id :: path else List.tl path in
+	    path, Some item
+	 | item                         -> path, Some item
+      in
       Printf.eprintf "processing file name: %s ...\n" name; flush stderr; 
       let file = Filename.concat st.input_path (name ^ st.script_ext) in
       let ich = open_in file in
       let lexbuf = Lexing.from_channel ich in
       try 
          let items = V8Parser.items V8Lexer.token lexbuf in
-         close_in ich;
-         init name; set_items st name items; commit st name
+         close_in ich; 
+	 let _, rev_items = X.list_rev_map_filter_fold filter [] items in
+	 let items = List.rev rev_items in
+	 let local_items, global_items = List.partition partition items in
+	 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;
+	 set_items st name local_items; commit st name
       with e -> 
          prerr_endline (Printexc.to_string e); close_in ich 
    in
-   init st.package; List.iter (produce st) st.files; commit st st.package
+   init st.input_package; require st st.input_package "preamble"; 
+   List.iter (produce st) st.files; 
+   commit st st.input_package