Commit bbb3861c authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

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).
parent 3799aa26
......@@ -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 ->
......
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
......
......@@ -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"
......@@ -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;
......
......@@ -31,3 +31,5 @@ val get_builtins: unit -> string list
val make_wrapper: (string -> unit) ref
val reset : unit -> unit
......@@ -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);
}
......@@ -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="#"
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
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