Re: [Caml-list] try ocaml website

[Gabriel Scherer <gabriel.scherer@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1296 bytes --]

I played with the toplevel a bit, but was frustrated by the limitation
of one-liner input.
Even in an interactive toplevel it is nice, I think, to be able to
write multiline programs.

The simple solution is to make ";;" mandatory, which clearly delimits
the end of user input (instead of considering all 'enter' as end of
input). The tryocaml toplevel is however very lenient regarding use of
";;", and I suppose this is a deliberate design choice.

I have implemented an heuristic to allow multiline input, based on a
past discussion with Nicolas Pouillard about, if I remember correctly,
Scala's toplevel behavior. The idea is to accumulate lines of input
until the parser either succeeds, or there is a syntax error; when it
just consumes all the line without producing a result, we wait for
more input.
Patch attached.

On Fri, Dec 23, 2011 at 7:49 PM, Çagdas Bozman
<cagdas.bozman@ocamlpro.com> wrote:
>> The only "real" thing that it's missing is a way to reset the toplevel
>> without reloading the page. It's the same problem as with the real
>> toplevel now that I think about it, but I didn't think of reloading the
>> page directly!
>>
>
> You can clear the editor view by using the command "clear()".
>
> --
> Çagdas Bozman <cagdas.bozman@ocamlpro.com>

[-- Attachment #2: 0001-Change-the-toplevel-to-allow-multiline-input.patch --]
[-- Type: text/x-diff, Size: 10335 bytes --]

From 263598f929d5d79d8dfe4ccb341565c0053abe06 Mon Sep 17 00:00:00 2001
From: Gabriel Scherer <gabriel.scherer@gmail.com>
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 "<br/>");
@@ -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