Skip to content

GitLab

Commit e116f3cc authored by Pietro Abate's avatar Pietro Abate
Browse files

[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
Hide whitespace changes
Inline Side-by-side
Showing with 136 additions and 95 deletions
INSTALL
View file @ e116f3cc
......@@ -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
View file @ e116f3cc
......@@ -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
View file @ e116f3cc
......@@ -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
View file @ e116f3cc
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
View file @ e116f3cc
......@@ -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
View file @ e116f3cc
......@@ -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
View file @ e116f3cc
......@@ -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.ml
View file @ e116f3cc
......@@ -136,68 +136,68 @@ let lex_tables = {
Lexing.lex_base =
"\000\000\023\000\011\000\015\000\254\255\042\000\046\000\255\255\
\250\255\249\255\255\255\041\000\253\255\019\000\252\255\252\255\
\251\255\000\000\002\000\253\255\249\255\248\255\009\000\054\000\
\007\000\021\000\053\000\252\255\056\000\009\000\024\000\059\000\
\022\000\027\000\057\000\054\000\251\255\250\255\072\000\090\000\
\075\000\126\000\078\000";
\251\255\000\000\002\000\253\255\248\255\247\255\009\000\054\000\
\007\000\020\000\021\000\053\000\252\255\056\000\025\000\049\000\
\069\000\022\000\025\000\037\000\046\000\250\255\070\000\073\000\
\090\000\076\000\126\000\079\000";
Lexing.lex_backtrk =
"\255\255\255\255\255\255\255\255\255\255\001\000\255\255\255\255\
\255\255\255\255\255\255\004\000\255\255\255\255\255\255\255\255\
\255\255\004\000\004\000\255\255\255\255\255\255\000\000\001\000\
\002\000\003\000\003\000\255\255\003\000\003\000\003\000\003\000\
\003\000\003\000\003\000\003\000\255\255\255\255\002\000\001\000\
\255\255\001\000\000\000";
\002\000\008\000\003\000\003\000\255\255\003\000\003\000\003\000\
\003\000\003\000\003\000\003\000\003\000\255\255\002\000\004\000\
\001\000\255\255\001\000\000\000";
Lexing.lex_default =
"\027\000\016\000\009\000\004\000\000\000\255\255\255\255\000\000\
"\028\000\016\000\009\000\004\000\000\000\255\255\255\255\000\000\
\000\000\000\000\000\000\255\255\000\000\255\255\000\000\000\000\
\000\000\255\255\255\255\000\000\000\000\000\000\255\255\255\255\
\255\255\255\255\255\255\000\000\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\000\000\000\000\255\255\255\255\
\255\255\255\255\255\255";
\255\255\255\255\255\255\255\255\000\000\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\000\000\255\255\255\255\
\255\255\255\255\255\255\255\255";
Lexing.lex_trans =
"\020\000\021\000\021\000\022\000\023\000\023\000\024\000\021\000\
\023\000\025\000\026\000\008\000\042\000\038\000\028\000\029\000\
\030\000\031\000\032\000\005\000\007\000\005\000\033\000\015\000\
\014\000\013\000\034\000\004\000\035\000\032\000\014\000\036\000\
\014\000\036\000\014\000\023\000\023\000\021\000\021\000\021\000\
"\020\000\021\000\021\000\022\000\023\000\023\000\024\000\025\000\
\023\000\026\000\027\000\008\000\043\000\038\000\029\000\030\000\
\031\000\032\000\033\000\005\000\007\000\005\000\034\000\015\000\
\039\000\013\000\035\000\004\000\036\000\033\000\014\000\037\000\
\014\000\037\000\014\000\023\000\023\000\021\000\021\000\021\000\
\014\000\017\000\010\000\011\000\010\000\012\000\006\000\013\000\
\006\000\018\000\006\000\014\000\006\000\014\000\019\000\014\000\
\019\000\007\000\039\000\039\000\039\000\007\000\039\000\014\000\
\014\000\038\000\039\000\014\000\040\000\014\000\014\000\039\000\
\004\000\004\000\004\000\037\000\014\000\014\000\038\000\041\000\
\041\000\042\000\000\000\041\000\000\000\000\000\000\000\000\000\
\000\000\039\000\039\000\039\000\039\000\039\000\039\000\039\000\
\039\000\000\000\039\000\000\000\000\000\000\000\039\000\000\000\
\040\000\000\000\000\000\039\000\000\000\000\000\041\000\041\000\
\006\000\018\000\006\000\014\000\006\000\014\000\019\000\009\000\
\019\000\007\000\040\000\040\000\040\000\007\000\040\000\014\000\
\014\000\014\000\040\000\014\000\041\000\014\000\014\000\040\000\
\004\000\004\000\004\000\038\000\038\000\039\000\014\000\014\000\
\042\000\042\000\043\000\000\000\042\000\000\000\014\000\000\000\
\000\000\040\000\040\000\040\000\040\000\040\000\040\000\040\000\
\040\000\000\000\040\000\000\000\000\000\000\000\040\000\000\000\
\041\000\000\000\000\000\040\000\000\000\000\000\000\000\042\000\
\042\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\040\000\040\000\040\000\
\040\000\040\000\042\000\042\000\042\000\000\000\042\000\000\000\
\000\000\000\000\042\000\000\000\000\000\000\000\000\000\042\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\039\000\039\000\039\000\
\039\000\039\000\041\000\041\000\041\000\000\000\041\000\000\000\
\000\000\000\000\041\000\000\000\000\000\000\000\000\000\041\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\041\000\041\000\041\000\041\000\041\000";
\000\000\042\000\042\000\042\000\042\000\042\000";
Lexing.lex_check =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\002\000\022\000\024\000\000\000\000\000\
\000\000\000\000\000\000\003\000\018\000\003\000\000\000\001\000\
\029\000\013\000\000\000\017\000\000\000\000\000\025\000\000\000\
\025\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\
\025\000\013\000\000\000\017\000\000\000\000\000\026\000\000\000\
\026\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\
\030\000\001\000\002\000\002\000\002\000\011\000\005\000\011\000\
\005\000\001\000\006\000\032\000\006\000\030\000\001\000\033\000\
\001\000\005\000\023\000\023\000\023\000\006\000\023\000\026\000\
\026\000\031\000\023\000\028\000\023\000\031\000\028\000\023\000\
\011\000\011\000\011\000\034\000\031\000\035\000\038\000\040\000\
\040\000\042\000\255\255\040\000\255\255\255\255\255\255\255\255\
\255\255\023\000\023\000\023\000\023\000\023\000\039\000\039\000\
\039\000\255\255\039\000\255\255\255\255\255\255\039\000\255\255\
\039\000\255\255\255\255\039\000\255\255\255\255\040\000\040\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\039\000\039\000\039\000\
\039\000\039\000\041\000\041\000\041\000\255\255\041\000\255\255\
\255\255\255\255\041\000\255\255\255\255\255\255\255\255\041\000\
\005\000\001\000\006\000\033\000\006\000\034\000\001\000\035\000\
\001\000\005\000\023\000\023\000\023\000\006\000\023\000\027\000\
\027\000\031\000\023\000\029\000\023\000\036\000\029\000\023\000\
\011\000\011\000\011\000\032\000\038\000\039\000\031\000\032\000\
\041\000\041\000\043\000\255\255\041\000\255\255\032\000\255\255\
\255\255\023\000\023\000\023\000\023\000\023\000\040\000\040\000\
\040\000\255\255\040\000\255\255\255\255\255\255\040\000\255\255\
\040\000\255\255\255\255\040\000\255\255\255\255\255\255\041\000\
\041\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\040\000\040\000\040\000\
\040\000\040\000\042\000\042\000\042\000\255\255\042\000\255\255\
\255\255\255\255\042\000\255\255\255\255\255\255\255\255\042\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\041\000\041\000\041\000\041\000\041\000"
\255\255\042\000\042\000\042\000\042\000\042\000"
}
let rec token engine lexbuf =
......@@ -220,7 +220,10 @@ let rec token engine lexbuf =
# 102 "parser/wlexer.mll"
"",Lexing.lexeme lexbuf )
| 4 -> (
# 104 "parser/wlexer.mll"
# 103 "parser/wlexer.mll"
"DIRECTIVE",Lexing.lexeme lexbuf )
| 5 -> (
# 105 "parser/wlexer.mll"
let string_start = Lexing.lexeme_start lexbuf in
string_start_pos := string_start;
let double_quote = Lexing.lexeme_char lexbuf 0 = '"' in
......@@ -229,16 +232,16 @@ let rec token engine lexbuf =
string_start - lexbuf.Lexing.lex_abs_pos;
(if double_quote then "STRING2" else "STRING1"),
(get_stored_string()) )
| 5 -> (
# 114 "parser/wlexer.mll"
| 6 -> (
# 115 "parser/wlexer.mll"
comment_start_pos := [Lexing.lexeme_start lexbuf];
comment engine lexbuf;
token engine lexbuf )
| 6 -> (
# 119 "parser/wlexer.mll"
"EOI","" )
| 7 -> (
# 121 "parser/wlexer.mll"
# 120 "parser/wlexer.mll"
"EOI","" )
| 8 -> (
# 122 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character ((Lexing.lexeme lexbuf).[0])) )
......@@ -247,17 +250,17 @@ let rec token engine lexbuf =
and comment engine lexbuf =
match engine lex_tables 1 lexbuf with
0 -> (
# 127 "parser/wlexer.mll"
# 128 "parser/wlexer.mll"
comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
comment engine lexbuf;
)
| 1 -> (
# 131 "parser/wlexer.mll"
# 132 "parser/wlexer.mll"
comment_start_pos := List.tl !comment_start_pos;
if !comment_start_pos <> [] then comment engine lexbuf;
)
| 2 -> (
# 135 "parser/wlexer.mll"
# 136 "parser/wlexer.mll"
string_start_pos := Lexing.lexeme_start lexbuf;
Buffer.clear string_buff;
let ender = Lexing.lexeme lexbuf in
......@@ -268,51 +271,51 @@ and comment engine lexbuf =
Buffer.clear string_buff;
comment engine lexbuf )
| 3 -> (
# 145 "parser/wlexer.mll"
# 146 "parser/wlexer.mll"
let st = List.hd !comment_start_pos in
error st (st+2) Unterminated_comment
)
| 4 -> (
# 149 "parser/wlexer.mll"
# 150 "parser/wlexer.mll"
comment engine lexbuf )
| _ -> failwith "lexing: empty token [comment]"
and string ender engine lexbuf =
match engine lex_tables 2 lexbuf with
0 -> (
# 153 "parser/wlexer.mll"
# 154 "parser/wlexer.mll"
let c = Lexing.lexeme lexbuf in
if c = ender then ()
else (store_len lexbuf;
store_char (Lexing.lexeme lexbuf);
string ender engine lexbuf) )
| 1 -> (
# 159 "parser/wlexer.mll"
# 160 "parser/wlexer.mll"
store_len lexbuf;
store_ascii (Lexing.lexeme_char lexbuf 1);
string ender engine lexbuf )
| 2 -> (
# 163 "parser/wlexer.mll"
# 164 "parser/wlexer.mll"
let c = Lexing.lexeme_char lexbuf 1 in
if c = 'x'
then parse_hexa_char engine lexbuf
else (store_len lexbuf; store_special c);
string ender engine lexbuf )
| 3 -> (
# 169 "parser/wlexer.mll"
# 170 "parser/wlexer.mll"
store_len lexbuf;
store_code (numeric_char (Lexing.lexeme lexbuf));
string ender engine lexbuf )
| 4 -> (
# 173 "parser/wlexer.mll"
# 174 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '\\') )
| 5 -> (
# 177 "parser/wlexer.mll"
# 178 "parser/wlexer.mll"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 6 -> (
# 179 "parser/wlexer.mll"
# 180 "parser/wlexer.mll"
store_len lexbuf;
store_code (Char.code (Lexing.lexeme_char lexbuf 0));
(* Adapt when source is UTF8 *)
......@@ -322,11 +325,11 @@ and string ender engine lexbuf =
and parse_hexa_char engine lexbuf =
match engine lex_tables 3 lexbuf with
0 -> (
# 186 "parser/wlexer.mll"
# 187 "parser/wlexer.mll"
store_len ~add:2 lexbuf;
store_code (hexa_char (Lexing.lexeme lexbuf)) )
| 1 -> (
# 189 "parser/wlexer.mll"
# 190 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character '\\') )
......@@ -334,7 +337,7 @@ and parse_hexa_char engine lexbuf =
;;
# 195 "parser/wlexer.mll"
# 196 "parser/wlexer.mll"
let delta_loc = ref 0
......
parser/wlexer.mll
View file @ e116f3cc
......@@ -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