[r2003-05-26 19:54:58 by cvscast] toplevel: Ctrl-D, Ctrl-C, #quit, #env

Original author: cvscast
Date: 2003-05-26 19:54:59+00:00

INSTALL

@@ -23,7 +23,7 @@ wlex
 pcre-ocaml 
   http://www.ai.univie.ac.at/~markus/home/ocaml_sources.html
 ocamlnet   
-  http://ocamlnet.sourceforge.net/
+  http://sourceforge.net/projects/ocamlnet
 pxp
   http://www.ocaml-programming.de/packages/documentation/pxp/index_dev.html
 

INSTALL.WIN32

@@ -5,7 +5,7 @@
 CDuce can be executed on Microsoft Windows by using the
 RedHat/Cygnus environment Cygwin freely available at
 
-http://www.cygwin.com
+http://www.cygwin.com/
 
 The executable needs the cygwin1.dll that is distributed 
 under GPL license. This is not compatible with the CDuce license.
@@ -33,7 +33,7 @@ wlex
 pcre-ocaml 
   http://www.ai.univie.ac.at/~markus/home/ocaml_sources.html
 ocamlnet   
-  http://ocamlnet.sourceforge.net/
+  http://sourceforge.net/projects/ocamlnet
 pxp
   http://www.ocaml-programming.de/packages/documentation/pxp/index_dev.html
 

driver/cduce.ml

@@ -2,6 +2,7 @@ open Location
 open Ident
 
 let quiet = ref false
+let toplevel = ref false
 
 let typing_env = State.ref "Cduce.typing_env" Env.empty
 
@@ -184,6 +185,12 @@ let rec phrases ppf phs = match phs with
   | { descr = Ast.Debug l } :: rest -> 
       debug ppf l;
       phrases ppf rest
+  | { descr = Ast.Directive `Quit } :: rest ->
+      if !toplevel then raise End_of_file;
+      phrases ppf rest
+  | { descr = Ast.Directive `Env } :: rest ->
+      dump_env ppf;
+      phrases ppf rest
   | [] -> ()
 
 let run rule ppf ppf_err input =
@@ -199,12 +206,13 @@ let run rule ppf ppf_err input =
     phrases ppf p;
     true
   with 
-    | (End_of_file | Failure _ | Not_found | Invalid_argument _) as e -> 
-	raise e  (* To get ocamlrun stack trace *)
+    | (End_of_file | Failure _ | Not_found | Invalid_argument _ | Sys.Break) 
+	as e -> 
+	raise e
     | exn -> 
 	print_exn ppf_err exn;
 	Format.fprintf ppf_err "@.";
 	false
 
 let script = run Parser.prog
-let toplevel = run Parser.top_phrases
+let topinput = run Parser.top_phrases

driver/cduce.mli

 val quiet: bool ref
+val toplevel: bool ref
 
 val enter_global_value : Ident.id -> Value.t -> Types.descr -> unit
 val script   : Format.formatter -> Format.formatter -> char Stream.t -> bool
-val toplevel : Format.formatter -> Format.formatter -> char Stream.t -> bool
+val topinput : Format.formatter -> Format.formatter -> char Stream.t -> bool
 
 val dump_env : Format.formatter -> unit

driver/run.ml

@@ -44,30 +44,55 @@ let ppf =
 let ppf_err = Format.err_formatter
 
 
-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 outflush s =
+  output_string stdout s;
+  flush stdout
 
 let toploop () =
+  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
+  Format.fprintf ppf "        CDuce version %s\n@." Cduce_config.version;
+  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;
   Location.push_source `Stream;
+  let read i =
+    if !bol then outflush "> ";
+    try 
+      let c = input_char stdin in
+      bol := c = '\n';
+      Some c
+    with Sys.Break -> quit () 
+  in
   let input = Stream.from read in
   let rec loop () =
-    first_line := true; bol := false;
-    ignore (Cduce.toplevel ppf ppf_err input);
+    outflush "# ";
+    bol := false;
+    ignore (Cduce.topinput ppf ppf_err input);
+    while (input_char stdin != '\n') do () done;
     loop () in
-  try loop ()
-  with End_of_file -> ()
+  (try loop () with End_of_file -> ());
+  restore ()
 
 let do_file s =
   let chan = open_in s in
@@ -106,11 +131,7 @@ let main () =
 	 Cduce.enter_global_value (ident (U.mk "argv")) l t
   );
   (match !src with
-     | [] -> 
-	 Format.fprintf ppf 
-	   "        CDuce version %s\n@."
-	   Cduce_config.version;
-	 toploop ()
+     | [] -> toploop ()
      | l -> List.iter do_file l);
   (match !dump with
      | Some f ->

parser/ast.ml

@@ -12,6 +12,7 @@ and pmodule_item' =
   | FunDecl of pexpr
   | EvalStatement of pexpr
   | Debug of debug_directive
+  | Directive of toplevel_directive
 and debug_directive =
   [ `Filter of ppat * ppat
   | `Sample of ppat
@@ -19,6 +20,10 @@ and debug_directive =
   | `Compile of ppat * ppat list 
   | `Subtype of ppat * ppat
   ]
+and toplevel_directive =
+  [ `Quit
+  | `Env
+  ]
 
 
 and pexpr = 

parser/parser.ml

@@ -97,7 +97,7 @@ EXTEND
   GLOBAL: top_phrases prog expr pat regexp const;
 
   top_phrases: [
-    [ l = LIST0 phrase; ";;" -> List.flatten l ]
+    [ l = LIST0 phrase; ";;" -> List.flatten l  ]
   ];
 
   prog: [
@@ -113,6 +113,8 @@ EXTEND
     | "type"; x = UIDENT; "="; t = pat -> [ mk loc (TypeDecl (x,t)) ]
     | "type"; x = LIDENT -> error loc "Type identifiers must be capitalized"
     | "debug"; d = debug_directive -> [ mk loc (Debug d) ]
+    | DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ]
+    | DIRECTIVE "#env" -> [ mk loc (Directive `Env) ]
     | "include"; s = STRING2 ->
 	let s = get_string s in
 	protect_op "File inclusion";

parser/wlexer.mll

@@ -100,6 +100,7 @@ rule token = parse
   | "{|" | "|}" | "<=" | ">=" | "<<" | ">>"
   | ["?+*"] "?"
 	{ "",Lexing.lexeme lexbuf }
+  | "#" lowercase+ { "DIRECTIVE",Lexing.lexeme lexbuf }
   | '"' | "'"
       { let string_start = Lexing.lexeme_start lexbuf in
         string_start_pos := string_start;