run.ml 4 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
let version () =
10
11
12
  Printf.eprintf "CDuce, version %s\n" <:symbol<cduce_version>>;
  Printf.eprintf "built on %s\n" <:symbol<build_date>>;
  Printf.eprintf "using OCaml %s compiler\n" <:symbol<ocaml_compiler>>;
13
14
  exit 0

15
let specs =
16
17
18
19
  [ "--dump", Arg.String (fun s -> dump := Some s), 
          "   specify filename for persistency";
    "--quiet", Arg.Set Cduce.quiet, 
           "  suppress normal output (typing, results)";
20
21
    "--expat", Arg.Unit (fun () -> Load_xml.use_parser := `Expat),
           "  use expat instead of PXP to parse XML documents";
22
    "-v", Arg.Unit version,
23
      "       print CDuce version";
24
    "--version", Arg.Unit version,
25
      "print CDuce version";
26
    "--license", Arg.Unit (fun () -> 
27
28
29
30
31
		      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),
32
      "print CDuce license";
33
34
35
   "--arg", Arg.Rest (fun s -> args := s :: !args),
       "    the arguments that follow are passed to the CDuce program (in argv)";  

36
 ]
37

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

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

47
48
49

let bol = ref true

50
51
52
let outflush s =
  output_string stdout s;
  flush stdout
53
54

let toploop () =
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
  Cduce.toplevel := true;
  let tcio = 
    try Unix.tcgetattr Unix.stdin
    with Unix.Unix_error (_,_,_) -> 
      (* The input is not a terminal *)
      Location.push_source `Stream;
      let input = Stream.of_channel stdin in
      let ok = Cduce.script ppf ppf_err input in
      if not ok then exit 1 else exit 0
  in
  let restore () = 
    Unix.tcsetattr Unix.stdin Unix.TCSADRAIN tcio
  in
  let quit () = 
    outflush "\n";
    restore ();
    exit 0
  in
73
  Format.fprintf ppf "        CDuce version %s\n@." <:symbol<cduce_version>>;
74
75
76
77
78
  Unix.tcsetattr Unix.stdin Unix.TCSADRAIN 
    { tcio with Unix.c_vquit = '\004' };
  Sys.set_signal Sys.sigquit (Sys.Signal_handle (fun _ -> quit ()));
  Sys.catch_break true;
  Cduce.toplevel := true;
79
  Location.push_source `Stream;
80
  let read i =
81
82
    if !bol then 
      if !Wlexer.in_comment then outflush "* " else outflush "> ";
83
84
85
86
87
88
    try 
      let c = input_char stdin in
      bol := c = '\n';
      Some c
    with Sys.Break -> quit () 
  in
89
90
  let input = Stream.from read in
  let rec loop () =
91
92
93
94
    outflush "# ";
    bol := false;
    ignore (Cduce.topinput ppf ppf_err input);
    while (input_char stdin != '\n') do () done;
95
    loop () in
96
97
  (try loop () with End_of_file -> ());
  restore ()
98

99
let do_file s =
100
101
  let chan = open_in s in
  Location.push_source (`File s);
102
  let input = Stream.of_channel chan in
103
104
105
106
107
108
109
  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)
110
111
112
113
    ); 
  let ok = Cduce.script ppf ppf_err input in
  close_in chan;
  if not ok then exit 1
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

  

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 ...@.")
129
130
131
132
     | None -> 
	 let l = List.rev_map Value.string_latin1 !args in
	 let l = Value.sequence l in
	 let t = Sequence.star Sequence.string in
133
	 Cduce.enter_global_value (ident (U.mk "argv")) l t
134
  );
135
  (match !src with
136
     | [] -> toploop ()
137
138
139
140
141
142
143
144
145
146
147
148
     | 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 -> ())



149
150
let () = main ()