run.ml 3.19 KB
Newer Older
1
2
open Ident

3
let () = State.close ();;
4

5
6
let dump = ref None
let src  = ref []
7
let args = ref []
8

9
10
11
12
13
14
15
let version () =
  Printf.eprintf "CDuce, version %s\n" Cduce_config.version;
  Printf.eprintf "built on %s\n" Cduce_config.build_date;
  Printf.eprintf "using OCaml %s compiler\n" 
    (if Cduce_config.native then "native" else "bytecode");
  exit 0

16
let specs =
17
18
19
20
  [ "--dump", Arg.String (fun s -> dump := Some s), 
          "   specify filename for persistency";
    "--quiet", Arg.Set Cduce.quiet, 
           "  suppress normal output (typing, results)";
21
    "-v", Arg.Unit version,
22
      "       print CDuce version";
23
    "--version", Arg.Unit version,
24
      "print CDuce version";
25
    "--license", Arg.Unit (fun () -> 
26
27
28
29
30
		      Printf.eprintf "\n\
The CDuce interpreter is distributed under the terms of the Q Public \n\
License version 1.0 (included in the sources). The Choice of Law section\n\
been modified from the original Q Public.\n\n
"; exit 0),
31
      "print CDuce license";
32
33
34
   "--arg", Arg.Rest (fun s -> args := s :: !args),
       "    the arguments that follow are passed to the CDuce program (in argv)";  

35
 ]
36

37
38
let () =
  Arg.parse specs (fun s -> src := s :: !src) 
39
    "\nUsage:\ncduce [OPTIONS ...] [FILE ...] [--arg argument ...]\n\nOptions:"
40

41
let ppf = 
42
  if !Cduce.quiet then Format.formatter_of_buffer (Buffer.create 1023)
43
44
  else Format.std_formatter
let ppf_err = Format.err_formatter
45

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

let first_line = ref true
let bol = ref true

let read i =
  let first = !first_line in
  if first
  then output_string stdout "* " 
  else if !bol then output_string stdout "> ";
  flush stdout;
  first_line := false;
  let c = input_char stdin in
  bol := (not first) && c = '\n';
  Some c


let toploop () =
  Location.push_source `Stream;
  let input = Stream.from read in
  let rec loop () =
    first_line := true; bol := false;
    ignore (Cduce.toplevel ppf ppf_err input);
    loop () in
  try loop ()
70
  with End_of_file -> ()
71

72
let do_file s =
73
74
  let chan = open_in s in
  Location.push_source (`File s);
75
  let input = Stream.of_channel chan in
76
77
78
79
80
81
82
  if Stream.peek input = Some '#' then
    (
      let rec count n =
	match Stream.next input with
	  | '\n' -> n
	  | _ -> count (n + 1) in
      Wlexer.set_delta_loc (count 1)
83
84
85
86
    ); 
  let ok = Cduce.script ppf ppf_err input in
  close_in chan;
  if not ok then exit 1
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

  

let main () =
  (match !dump with
     | Some f ->
	 (try 
	    Format.fprintf ppf "Restoring state: ";
	    let chan = open_in_bin f in
	    let s = Marshal.from_channel chan in
	    close_in chan;
	    State.set s;
	    Format.fprintf ppf "done ...@."
	  with Sys_error _ ->  
	    Format.fprintf ppf "failed ...@.")
102
103
104
105
     | None -> 
	 let l = List.rev_map Value.string_latin1 !args in
	 let l = Value.sequence l in
	 let t = Sequence.star Sequence.string in
106
	 Cduce.enter_global_value (ident (U.mk "argv")) l t
107
  );
108
109
  (match !src with
     | [] -> 
110
	 Format.fprintf ppf 
111
	   "        CDuce version %s\n@."
112
	   Cduce_config.version;
113
	 toploop ()
114
115
116
117
118
119
120
121
122
123
124
125
     | l -> List.iter do_file l);
  (match !dump with
     | Some f ->
	 Format.fprintf ppf "Saving state ...@\n";
	 let s = State.get () in
	 let chan = open_out_bin f in
	 Marshal.to_channel chan s [ Marshal.Closures ];
	 close_out chan
     | None -> ())



126
127
let () = main ()