Commit e116f3cc authored by Pietro Abate's avatar Pietro Abate

[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
parent e5a2b720
......@@ -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
......
......@@ -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
......
......@@ -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
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
......@@ -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 ->
......
......@@ -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 =
......
......@@ -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";
......
This diff is collapsed.
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment