From 263598f929d5d79d8dfe4ccb341565c0053abe06 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 25 Dec 2011 10:40:41 +0100 Subject: [PATCH] Change the toplevel to allow multiline input The heuristic is the following: if parsing the input consumed the whole line without raising a syntax error, we assume that it is unfinished multiline input. We end the input as soon as parsing raises a syntactic error, or succeeds. Note that this may sometimes terminate input earlier than intended. For example, if you try to write: let rec fac = function | 0 -> 1 | n -> ... then parsing will return a result at the end of the "| 0 -> 1", and evaluate this incomplete definition. You have to write instead: let rec fac = begin function | 0 -> 1 | n -> ... end So that `begin` make all prefixes of the input (before `end`) invalid. --- tryocaml/toplevel.ml | 240 +++++++++++++++++++++++++++++++++++-------------- 1 files changed, 171 insertions(+), 69 deletions(-) diff --git a/tryocaml/toplevel.ml b/tryocaml/toplevel.ml index d3f0ac7..2fb5bad 100644 --- a/tryocaml/toplevel.ml +++ b/tryocaml/toplevel.ml @@ -75,39 +75,6 @@ let start ppf = Toploop.input_name := ""; exec ppf "open Tutorial" -let at_bol = ref true -let consume_nl = ref false - -let refill_lexbuf s p ppf buffer len = - if !consume_nl then begin - let l = String.length s in - if (!p < l && s.[!p] = '\n') then - incr p - else if (!p + 1 < l && s.[!p] = '\r' && s.[!p + 1] = '\n') then - p := !p + 2; - consume_nl := false - end; - if !p = String.length s then - 0 - else begin - let c = s.[!p] in - incr p; - buffer.[0] <- c; - if !at_bol then Format.fprintf ppf "# "; - at_bol := (c = '\n'); - if c = '\n' then - Format.fprintf ppf "@." - else - Format.fprintf ppf "%c" c; - 1 - end - -let ensure_at_bol ppf = - if not !at_bol then begin - Format.fprintf ppf "@."; - consume_nl := true; at_bol := true - end - let update_lesson_text () = if !Tutorial.this_lesson <> 0 then try @@ -172,9 +139,6 @@ let text_of_html html = done; Buffer.contents b - - - let update_debug_message = let b = Buffer.create 100 in Tutorial.debug_fun := (fun s -> Buffer.add_string b s; Buffer.add_string b "
"); @@ -195,39 +159,176 @@ let update_debug_message = with _ -> () -let loop s ppf buffer = - let need_terminator = ref true in - for i = 0 to String.length s - 2 do - if s.[i] = ';' && s.[i+1] = ';' then need_terminator := false; - done; - let s = if !need_terminator then s ^ ";;" else s in - let lb = Lexing.from_function (refill_lexbuf s (ref 0) ppf) in - begin try - while true do - begin - try - let phr = !Toploop.parse_toplevel_phrase lb in - ensure_at_bol ppf; - Buffer.clear buffer; - Tutorial.print_debug s; - ignore (Toploop.execute_phrase true ppf phr); - let res = Buffer.contents buffer in - Tutorial.check_step ppf s res; - update_lesson_text (); - update_lesson_number (); - update_lesson_step_number (); - with - End_of_file -> - raise End_of_file - | x -> - ensure_at_bol ppf; - Errors.report_error ppf x - end; - update_debug_message (); - done - with End_of_file -> () - end +(* auxiliary type and functions for `loop`, see below *) +type 'a parse_status = + | Error of exn * int + | Success of 'a * int + | Need_more_input + +let try_parse str p = + let pos = ref p in + let len = String.length str in + let lb = + (* add a space at the end so that input ending with ';;' + don't raise Need_more_input *) + Lexing.from_function (fun output _len -> + if !pos = len then (incr pos; ' '; 0) + else begin + output.[0] <- str.[!pos]; + incr pos; + 1 + end) in + try + let result = !Toploop.parse_toplevel_phrase lb in + Success (result, lb.Lexing.lex_last_pos) + with exn -> + if !pos = len + 1 then Need_more_input + else Error (exn, lb.Lexing.lex_last_pos) +let execute_phrase phrase ppf output_buffer = + try + Buffer.clear output_buffer; + ignore (Toploop.execute_phrase true ppf phrase); + let res = Buffer.contents output_buffer in + Tutorial.check_step ppf s res; + update_lesson_text (); + update_lesson_number (); + update_lesson_step_number (); + with exn -> + Errors.report_error ppf exn + +let skip_whitespace s pos = + let rec loop i = + if i = String.length s then None + else match s.[i] with + | '\r' | '\n' | '\t' | ' ' -> loop (i+1) + | _ -> Some i in + loop pos + +let format_string pos len ppf str = + let last_was_r = ref false in + for i = pos to pos + len - 1 do + match str.[i] with + | '\r' -> + if !last_was_r then Format.fprintf ppf "\r"; + last_was_r := true; + | c -> + if c = '\n' then Format.fprintf ppf "@." + else if !last_was_r then Format.fprintf ppf "\r"; + Format.fprintf ppf "%c" c; + last_was_r := false; + done + +(* `loop` is called for each line entered in the toplevel. + + In order to allow for multi-line input, we use the following + heuristic: if parsing the line didn't raise any syntax error, but + didn't succeed in parsing a complete line, we simply accumulate the + input into an input buffer, and wait for the next call to `loop`. + + Once a syntax error is encountered, or we have succeeded in parsing + a whole phrase, we show the result and clear the input buffer. + + For example, if the user enters "let x =", it is not a syntax + error, and we wait for the next line of input. If it is "1", we + have the complete phrase "let x = 1" which we execute in the + toplevel. If it is "1 in", we wait againt for the next line. Note + that his heuristic is imperfect: when the user writes "let x =\n + 1\n", he may have wished to end with "in x + x", but we decide that + the phrase stops here. + + The return value of `loop` is the rest of the input, after the last + phrase that could be parsed. + + The code is complexified by two aspects: + + - We try to be lenient in asking the user to close its phrases + using ';;'. She is not forced to use it, and when we see that the + phrase is unfinished we try to add ';;' at the end and retry + parsing. + + - We need to print the user input to the output HTML buffer, but we + don't do it by batch, we try to do phrase per phrase.. For example, + entering "1;; 2" will not print "1;; 2", then the result of the two + phrases, but "# 1;;", then the result of this phrase, and "# 2;;", + and the result of that phrase. +*) +let loop = + let input_buffer = Buffer.create 80 in +fun line ppf output_buffer -> + (* last_pos is the length of the partially entered multiline input + that has already been printed back to the user *) + let last_pos = Buffer.length input_buffer in + Buffer.add_string input_buffer line; + let input = Buffer.contents input_buffer in + let input_closed = input ^ ";;" in + let format_phrase marker str suffix pos len = + Format.fprintf ppf "%c %a%s@." marker + (format_string pos len) str suffix in + (* parse a phrase starting at position `pos` in the input string; + the first parsing attempt is handled differently below, + as it may be incomplete *) + let rec parse_next pos = + match skip_whitespace input pos with + | None -> "" + | Some pos -> + match try_parse input pos with + | Error (exn, offset) -> + let len = offset+1 in + format_phrase '#' input "" pos len; + Errors.report_error ppf exn; + parse_next (pos + len) + | Success (phrase, offset) -> + let len = offset+1 in + format_phrase '#' input "" pos len; + execute_phrase phrase ppf output_buffer; + parse_next (pos + len) + | Need_more_input -> + begin match try_parse input_closed pos with + | Error _ | Need_more_input -> + begin match skip_whitespace input pos with + | None -> "" + | Some i -> String.sub input i (String.length input - i) + end + | Success (phrase, _) -> + let len = String.length input - pos in + format_phrase '#' input ";;" pos len; + execute_phrase phrase ppf output_buffer; + "" + end + in + (* if this is not the first line of input, + we use '>' rather than '#' as a visual prompt marker, + to let the user know that she's continuing the phrase. *) + let marker = if last_pos = 0 then '#' else '>' in + match try_parse input 0 with + | Error (exn, pos) -> + let len = pos + 1 - last_pos in + format_phrase marker input "" last_pos len; + Buffer.clear input_buffer; + Errors.report_error ppf exn; + parse_next (last_pos + len) + | Success (first_phrase, pos) -> + let len = pos + 1 - last_pos in + format_phrase marker input "" last_pos len; + Buffer.clear input_buffer; + execute_phrase first_phrase ppf output_buffer; + parse_next (last_pos + len) + | Need_more_input -> + (* if we need to close to get the phrase, + there are no further phrases *) + match try_parse input_closed 0 with + | Error _ | Need_more_input -> + let len = String.length input - last_pos in + format_phrase marker input "" last_pos len; + Buffer.add_char input_buffer '\n'; + "" + | Success (phrase, _) -> + let len = String.length input - last_pos in + format_phrase marker input ";;" last_pos len; + Buffer.clear input_buffer; + execute_phrase phrase ppf output_buffer; + "" let _ = Tutorial.message_fun := (fun s -> @@ -305,7 +406,8 @@ let run _ = history_bckwrd := !history; history_frwrd := []; textbox##value <- Js.string ""; - loop s ppf buffer; + let remaining_input = loop s ppf buffer in + textbox##value <- Js.string remaining_input; make_code_clickable (); textbox##focus(); container##scrollTop <- container##scrollHeight; -- 1.7.5.4