diff --git a/ml-proto/host/load.ml b/ml-proto/host/load.ml deleted file mode 100644 index 16d1b490fc..0000000000 --- a/ml-proto/host/load.ml +++ /dev/null @@ -1,11 +0,0 @@ -let load file = - let f = open_in file in - let size = in_channel_length f + 1 in - let buf = bytes_create size in - let rec loop () = - let len = input f buf 0 size in - let source = Bytes.sub_string 0 len in - if len < size then source else source ^ loop () - in loop (); - close_in f; - source diff --git a/ml-proto/host/main.ml b/ml-proto/host/main.ml index 0c4302a208..96573ffcbd 100644 --- a/ml-proto/host/main.ml +++ b/ml-proto/host/main.ml @@ -1,24 +1,13 @@ let name = "wasm" -let version = "0.1" +let version = "0.2" -let load file = - let f = open_in file in - let size = in_channel_length f + 1 in - let buf = Bytes.create size in - let rec loop () = - let len = input f buf 0 size in - let source = Bytes.sub_string buf 0 len in - if len == 0 then source else source ^ loop () - in - let source = loop () in - close_in f; - source +let banner () = + print_endline (name ^ " " ^ version ^ " spec interpreter") -let parse name source = - let lexbuf = Lexing.from_string source in +let parse name lexbuf start = lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = name}; - try Parser.script Lexer.token lexbuf with Script.Syntax (region, s) -> + try start Lexer.token lexbuf with Script.Syntax (region, s) -> let region' = if region <> Source.no_region then region else {Source.left = Lexer.convert_pos lexbuf.Lexing.lex_start_p; Source.right = Lexer.convert_pos lexbuf.Lexing.lex_curr_p} in @@ -29,10 +18,9 @@ let error at category msg = prerr_endline (Source.string_of_region at ^ ": " ^ msg); false -let process file source = +let process file lexbuf start = try - Script.trace "Parsing..."; - let script = parse file source in + let script = parse file lexbuf start in Script.trace "Desugaring..."; let script' = Script.desugar script in Script.trace "Running..."; @@ -48,21 +36,44 @@ let process file source = let process_file file = Script.trace ("Loading (" ^ file ^ ")..."); - let source = load file in - if not (process file source) then exit 1 + let ic = open_in file in + try + let lexbuf = Lexing.from_channel ic in + Script.trace "Parsing..."; + let success = process file lexbuf Parser.script in + close_in ic; + if not success then exit 1 + with exn -> close_in ic; raise exn + +let continuing = ref false + +let lexbuf_stdin buf len = + let prompt = if !continuing then " " else "> " in + print_string prompt; flush_all (); + continuing := true; + let rec loop i = + if i = len then i else + let ch = input_char stdin in + Bytes.set buf i ch; + if ch = '\n' then i + 1 else loop (i + 1) + in + let n = loop 0 in + if n = 1 then continuing := false else Script.trace "Parsing..."; + n let rec process_stdin () = - print_string (name ^ "> "); flush_all (); - match try Some (input_line stdin) with End_of_file -> None with - | None -> + banner (); + let lexbuf = Lexing.from_function lexbuf_stdin in + let rec loop () = + let success = process "stdin" lexbuf Parser.script1 in + if not success then Lexing.flush_input lexbuf; + if Lexing.(lexbuf.lex_curr_pos >= lexbuf.lex_buffer_len - 1) then + continuing := false; + loop () + in + try loop () with End_of_file -> print_endline ""; Script.trace "Bye." - | Some source -> - ignore (process "stdin" source); - process_stdin () - -let greet () = - print_endline ("Version " ^ version) let usage = "Usage: " ^ name ^ " [option] [file ...]" let argspec = Arg.align @@ -72,7 +83,7 @@ let argspec = Arg.align "-s", Arg.Set Flags.print_sig, " show module signatures"; "-d", Arg.Set Flags.dry, " dry, do not run program"; "-t", Arg.Set Flags.trace, " trace execution"; - "-v", Arg.Unit greet, " show version" + "-v", Arg.Unit banner, " show version" ] let () = @@ -84,7 +95,7 @@ let () = List.iter process_file !files; if !Flags.interactive then process_stdin () with exn -> - flush stdout; + flush_all (); prerr_endline (Sys.argv.(0) ^ ": uncaught exception " ^ Printexc.to_string exn); Printexc.print_backtrace stderr; diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index feb34a5ccb..213882ed95 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -186,8 +186,9 @@ let implicit_decl c t at = %nonassoc LOW %nonassoc VAR -%start script +%start script script1 %type script +%type script1 %% @@ -487,5 +488,7 @@ const_list : script : | cmd_list EOF { $1 } ; - +script1 : + | cmd { [$1] } +; %%