Add a way to reset the toplevel while maintaining the session alive.

(Clears the type and compile environment, the compilation unit table, the table of named types and reset to their default values).

driver/cduce.ml

@@ -11,7 +11,7 @@ let extra_specs = ref []
 
 (* if set to false toplevel exception aren't cought.
  * Useful for debugging with OCAMLRUNPARAM="b" *)
-let catch_exceptions = true
+let catch_exceptions = ref true
 
 (* retuns a filename without the suffix suff if any *)
 let prefix filename suff =
@@ -28,6 +28,17 @@ let silent = ref false
 let typing_env = ref Builtin.env
 let compile_env = ref Compile.empty_toplevel
 
+let reset_toplevel () =
+  Librarian.reset ();
+  Types.Print.clear ();
+  Typer.register_types "" Builtin.env;
+  typing_env := Builtin.env;
+  compile_env := Compile.empty_toplevel
+
+
+
+
+
 let get_global_value cenv v =
   Eval.eval_var (Compile.find v !compile_env)
 
@@ -332,7 +343,7 @@ let phrases ppf phs =
   ev_top ~run:true ~show:(show ppf)  ~directive:(directive ppf) phs
 
 let catch_exn ppf_err exn =
-  if not catch_exceptions then raise exn;
+  if not !catch_exceptions then raise exn;
   match exn with
   | (End_of_file | Failure _ | Not_found | Invalid_argument _ | Sys.Break)
       as e ->

driver/cduce.mli

 exception Escape of exn
 
 val toplevel: bool ref
+val reset_toplevel : unit -> unit
 val verbose: bool ref
-
+val catch_exceptions: bool ref
 val extra_specs: (string * Arg.spec * string) list ref
 
 val script : Format.formatter -> Format.formatter -> char Stream.t -> bool

driver/cduceeditor_js_runtime.ml

@@ -66,7 +66,7 @@ let coord_index str pos =
 
 
 
-let setup_editor outfmt errfmt button_id =
+let setup_compile_run outfmt errfmt button_id =
   let button =
     get_opt (Dom_html.document ## getElementById (Js.string button_id))
   in
@@ -107,14 +107,68 @@ let setup_editor outfmt errfmt button_id =
   button ## onclick <- handler
 
 
+let setup_evaluate outfmt errfmt get_text button_id =
+  let button =
+    get_opt (Dom_html.document ## getElementById (Js.string button_id))
+  in
+  let handler =
+    Dom.handler
+      (fun ev ->
+       let global = Js.Unsafe.global in
+       let editor = Js.Unsafe.get global (Js.string "editor") in
+       let phrases = get_text () in
+       Array.iter (fun (offset, code) ->
+		   try
+		     ignore (Cduce.topinput outfmt errfmt (Stream.of_string code))
+
+		   with
+		     (Cduce_loc.Location ((_,i,j), _, _) |
+		      Ulexer.Error (i,j,_)  ) as e ->
+		     let xi, yi = coord_index code (offset + i) in
+		     let xj, yj = coord_index code (offset + j) in
+		     ignore (Js.Unsafe.meth_call global "highlightError"
+						 (Array.map Js.Unsafe.inject [| xi; yi; xj; yj |]));
+		     Cduce.print_exn errfmt e;
+		     Format.pp_print_flush errfmt ();
+		     ignore (Js.Unsafe.meth_call editor "focus" [| |])
+
+		   | Failure s -> log(s)
+		  ) phrases;
+       Js._false
+      )
+  in
+  button ## onclick <- handler
+
+let get_whole_buffer () =
+  let global = Js.Unsafe.global in
+  let editor = Js.Unsafe.get global (Js.string "editor") in
+  let code : Js.js_string Js.t = Js.Unsafe.meth_call editor "getValue" [| |] in
+  let results = Js.to_array (Js.str_array (code ## split (Js.string ";;"))) in
+  let offset = ref 0 in
+  Array.map (fun s ->
+	     let s = (Js.to_string s) ^ ";;" in
+	     let o = !offset in
+	     offset := !offset + String.length s;
+	     (o, s)) results
+
+
+let setup_action f button_id =
+  let button =
+    get_opt (Dom_html.document ## getElementById (Js.string button_id))
+  in
+  button ## onclick <- (Dom.handler (fun _ -> f ()))
+
 let () =
-    Cduce_config.init_all ();
-    Cduce_js.use ();
-    let outputdiv = get_opt (Dom_html.document ## getElementById (Js.string "console")) in
-    let fmt = make_ppf outputdiv "stdout" in
-    let fmt_err = make_ppf outputdiv "stderr" in
-    make_out_channel stdout outputdiv "stdout";
-    make_out_channel stderr outputdiv "stderr";
-    Cduce.toplevel := false;
-    Librarian.run_loaded := true;
-    setup_editor fmt fmt_err "compile-and-run"
+  Cduce_config.init_all ();
+  Cduce_js.use ();
+  let outputdiv = get_opt (Dom_html.document ## getElementById (Js.string "console")) in
+  let fmt = make_ppf outputdiv "stdout" in
+  let fmt_err = make_ppf outputdiv "stderr" in
+  make_out_channel stdout outputdiv "stdout";
+  make_out_channel stderr outputdiv "stderr";
+  Cduce.toplevel := true;
+  Cduce.catch_exceptions := false;
+  Librarian.run_loaded := true;
+  setup_compile_run fmt fmt_err "compile-and-run";
+  setup_evaluate fmt fmt_err get_whole_buffer "evaluate-buffer";
+  setup_action (fun () -> Cduce.reset_toplevel (); Js._false) "reset-toplevel"

driver/librarian.ml

@@ -34,6 +34,8 @@ let tbl = Tbl.create 64
 module CTbl = Hashtbl.Make(Compunit)
 let ctbl = CTbl.create 64
 
+let reset () = Tbl.clear tbl; CTbl.clear ctbl
+
 let mk name descr typing compile code ext_info depends =
   { name = name;
     descr = descr;

driver/librarian.mli

@@ -31,3 +31,5 @@ val get_builtins: unit -> string list
 
 
 val make_wrapper: (string -> unit) ref
+
+val reset : unit -> unit

tests/js/cduceeditor_helper.js

@@ -175,5 +175,22 @@ function toggleVerbose()
     editor.focus();
 }
 
-editor.focus();
-
+function triggerKeyPress(code, ctrl, meta)
+{
+    var keyboardEvent = document.createEvent("KeyboardEvent");
+    var initMethod = typeof keyboardEvent.initKeyboardEvent !== 'undefined' ? "initKeyboardEvent" : "initKeyEvent";
+    keyboardEvent[initMethod](
+        "keydown", // event type : keydown, keyup, keypress
+        true, // bubbles
+        true, // cancelable
+        window, // viewArg: should be window
+        ctrl, // ctrlKeyArg
+        false, // altKeyArg
+        false, // shiftKeyArg
+        meta, // metaKeyArg
+        code, // keyCodeArg : unsigned long the virtual key code, else 0
+        0 // charCodeArgs : unsigned long the Unicode character associated with the depressed key, else 0
+    );
+
+    document.dispatchEvent(keyboardEvent);
+}

tests/js/editor.xhtml

@@ -50,6 +50,9 @@
 	</li>
 	<li><a href="#">Compile</a>
 	  <ul>
+	    <li><a href="#" id="evaluate-buffer">Evaluate
+		buffer</a></li>
+	    <li><a href="#" id="reset-toplevel">Reset toplevel</a></li>
 	    <li><a href="#" id="compile-and-run">Compile &amp;
 		run</a></li>
 	    <li><a href="#"

types/builtin.ml

@@ -31,16 +31,16 @@ let types =
     "Out_channel", out_channel;
   ]
 
+    
 let env =
   List.fold_left
     (fun accu (n,t) ->
-       let n = (Ns.empty, Ident.U.mk n) in
-       Types.Print.register_global ("",n,[]) t;
-       Typer.enter_type (Ident.ident n) t accu
+     let n = (Ns.empty, Ident.U.mk n) in
+     Types.Print.register_global ("",n,[]) t;
+     Typer.enter_type (Ident.ident n) t accu
     )
     Typer.empty_env
     types
-
 (* Operators *)
 
 open Operators

types/types.ml

@@ -1948,6 +1948,10 @@ module Print = struct
 
   let named = ref DescrMap.empty
   let named_xml = ref DescrPairMap.empty
+  let clear () =
+    named := DescrMap.empty;
+    named_xml := DescrPairMap.empty
+
   let register_global (cu,name,al) d =
     let d = uniq d in
     if is_empty (VarXml.update d VarXml.empty) then begin

types/types.mli

@@ -387,6 +387,7 @@ val cond_partition: t -> (t * t) list -> t list
 module Print : sig
   type gname = string * Ns.QName.t * (Var.t * t) list
   val register_global : gname -> t -> unit
+  val clear : unit -> unit
   val pp_const : Format.formatter -> const -> unit
   val pp_type: Format.formatter -> t -> unit
   val pp_node: Format.formatter -> Node.t -> unit