[r2003-10-10 20:20:24 by cvscast] Beppe: added option -o that allows to...

[r2003-10-10 20:20:24 by cvscast] Beppe: added option -o that allows to specify the output file of the
compilation

Original author: cvscast
Date: 2003-10-10 20:20:25+00:00

driver/cduce.ml

@@ -304,11 +304,11 @@ let run rule ppf ppf_err input =
 let script = run Parser.prog
 let topinput = run Parser.top_phrases
 
-let compile src =
+let compile src out=
   try
     let id = Types.CompUnit.mk (U.mk_latin1 src) in
-    Librarian.compile id;
-    Librarian.save id;
+      Librarian.compile id;
+      Librarian.save id out;
     exit 0
   with exn -> catch_exn Format.err_formatter exn; exit 1
   

driver/cduce.mli

@@ -8,6 +8,6 @@ val topinput : Format.formatter -> Format.formatter -> char Stream.t -> bool
 
 val dump_env : Format.formatter -> unit
 
-val compile: string -> unit
+val compile: string -> string -> unit
 val compile_run: string -> Value.t -> unit
 val run: string -> Value.t -> unit

driver/librarian.ml

@@ -56,14 +56,17 @@ let source_filename id =
     let filename = Encodings.Utf8.to_string (C.value id) 
      in if (Filename.check_suffix filename "cd") then filename else filename^ ".cd"
 
-(* if we add an option for the user to specify the output file then we probably *)
-(* should not add the .cdo at the end                                           *)
-let object_filename id = 
-    let filename = Encodings.Utf8.to_string (C.value id) 
-     in if (Filename.check_suffix filename "cd") then filename else filename ^ ".cdo"
+let object_filename id  obj = 
+    match obj with
+      | "" ->  let filename = Encodings.Utf8.to_string (C.value id) in 
+               (if (Filename.check_suffix filename ".cd") 
+                then Filename.chop_suffix filename ".cd" else filename) ^ ".cdo"
+     | _ -> obj 
+
+
 
 
-let save id =
+let save id out=
   let cu = find id in
   C.enter id;
   let raw = Serialize.Put.run serialize cu in
@@ -86,7 +89,7 @@ let save id =
 
   let depend = Serialize.Put.run serialize_dep depend in
   let digest = Digest.string raw in
-  let oc = open_out (object_filename id) in
+  let oc = open_out (object_filename id out) in
   output_value oc (digest,depend,raw);
   close_out oc
   
@@ -147,7 +150,7 @@ let rec load id =
     if !during_compile then depends := id :: !depends;
 (*    Printf.eprintf "load %s: start\n" (object_filename id);
     flush stderr; *)
-    let ic = open_in (object_filename id) in
+    let ic = open_in (object_filename id "") in
     let (dig, depend, raw) = input_value ic in
     close_in ic;
     let depend = Serialize.Get.run deserialize_dep depend in

driver/librarian.mli

 val compile: Types.CompUnit.t -> unit
 val run:  Value.t -> Types.CompUnit.t -> unit
 val import: Types.CompUnit.t -> unit
-val save: Types.CompUnit.t -> unit
+val save: Types.CompUnit.t -> string -> unit
 

driver/run.ml

@@ -5,6 +5,7 @@ let () = State.close ();;
 let load_dump = ref None
 let save_dump = ref None
 
+let out_file  = ref [] (* stores the name of the output file *)
 let src  = ref []
 let args = ref []
 
@@ -37,6 +38,8 @@ let specs =
            "  suppress normal output (typing, results)";
     "--compile", Arg.Set compile,
            "compile the given CDuce file";
+    "-o",  Arg.String (fun s -> out_file := s :: !out_file),
+      "       output file for compilation";           
     "--run", Arg.Set run,
            "    execute the given CDuce object file";
     "--stdin", Arg.Unit (fun () -> src := "" :: !src),
@@ -82,24 +85,29 @@ let err s =
 let mode =
   Arg.parse specs (fun s -> src := s :: !src) 
     "Usage:\ncduce [OPTIONS ...] [FILE ...] [--arg argument ...]\n\nOptions:";
-  match (!compile,!run,!src,!args) with
-    | false, false, [],  args   -> `Toplevel args
-    | false, false, [x], args   -> `Script (x,args)
-    | false,  false, _, _        ->
+  match (!compile,!out_file,!run,!src,!args) with
+    | false, [_], _,  _, _   -> 
+	err "-o option can be used only with the --compile one"
+    | false, _, false, [],  args   -> `Toplevel args
+    | false, _, false, [x], args   -> `Script (x,args)
+    | false, _, false, _, _        ->
 	err "Only one CDuce program can be executed at a time"
-    | true,  false, [x], []     -> `Compile x
-    | true,  false, [], []      ->
+    | true,  [o], false, [x], []     -> `Compile (x,o) 
+    | true,  [], false, [x], []     -> `Compile (x,"") 
+    | true,  [], false, [], []      ->
 	err "Please specifiy the CDuce program to be compiled"
-    | true,  false, _, []       ->
+    | true,  [], false, _, []       ->
 	err "Only one CDuce program can be compiled at a time"
-    | true,  false, _, _        ->
+    | true,  _, false, _, []        ->
+	err "Please specify only one output file"
+    | true,  _, false, _, _        ->
 	err "No argument can be passed to programs at compile time"
-    | false, true,  [x], args   -> `Run (x,args)
-    | false, true,  [], _       ->
+    | false, _, true,  [x], args   -> `Run (x,args)
+    | false, _, true,  [], _       ->
 	err "Please specifiy the CDuce program to be executed"
-    | false, true,   _, _       ->
+    | false, _, true,   _, _       ->
 	err "Only one CDuce program can be executed at a time"
-    | true, true,   _,  _       ->
+    | true, _, true,   _,  _       ->
 	err "The options --compile and --run are incompatible"
 	
 
@@ -206,8 +214,8 @@ let main () =
 	save ()
     | `Script (f,args) ->
 	Cduce.compile_run f (argv args)
-    | `Compile f ->
-	Cduce.compile f
+    | `Compile (f,o) ->
+	Cduce.compile f o
     | `Run (f,args) ->
 	Cduce.run f (argv args)