From 9a6241752f61d1a3a064342e0a181644596b97c1 Mon Sep 17 00:00:00 2001
From: charguer <arthur@chargueraud.org>
Date: Fri, 25 Mar 2016 15:47:46 +0100
Subject: [PATCH] mlbrowser and if

---
 generator/Makefile     | 10 ++---
 generator/TODO         |  4 +-
 generator/js_of_ast.ml | 86 ++++++++++++++----------------------------
 navig-driver.js        | 34 ++++++++++-------
 4 files changed, 55 insertions(+), 79 deletions(-)

diff --git a/generator/Makefile b/generator/Makefile
index 7404d6c..5d212dc 100644
--- a/generator/Makefile
+++ b/generator/Makefile
@@ -86,10 +86,8 @@ CC          := ocamlc -c
 OCAMLDEP    := ocamldep -one-line
 OCAMLBUILD := ocamlbuild -j 4 -classic-display -use-ocamlfind -X tests -X $(STDLIB_DIR)
 
-GENERATOR := ./main.byte
-
 LINEOF := ./lineof.byte
-
+MLTOJS := OCAMLRUNPARAM="l=100M" ./main.byte
 
 ###############################################################
 # Dependencies
@@ -129,13 +127,13 @@ tests/%.cmi: tests/%.mli stdlib
 ##### Rule for log/unlog/token
 
 tests/%.log.js: tests/%.ml main.byte stdlib tests/%.cmi
-	./main.byte -mode log -I $(<D) $<
+	$(MLTOJS) -mode log -I $(<D) $<
 
 tests/%.unlog.js: tests/%.ml main.byte stdlib tests/%.cmi
-	./main.byte -mode unlog -I $(<D) $<
+	$(MLTOJS) -mode unlog -I $(<D) $<
 
 tests/%.token.js tests/%.mlloc.js: tests/%.ml main.byte stdlib tests/%.cmi
-	./main.byte -mode token -I $(<D) $<
+	$(MLTOJS) -mode token -I $(<D) $<
 
 ##### Rule for lineof.js
 
diff --git a/generator/TODO b/generator/TODO
index c218a52..7c99758 100644
--- a/generator/TODO
+++ b/generator/TODO
@@ -6,9 +6,7 @@ NEW NEW TODO
 
 - restore button step into / next
 
-- tokens for if statement
-
-- switch,return,call,var generate events, 
+- if switch,return,call,var generate events, 
 
 
 NEW TODO
diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index 2abaa56..2442f6f 100644
--- a/generator/js_of_ast.ml
+++ b/generator/js_of_ast.ml
@@ -185,9 +185,6 @@ let ppf_ifthen cond iftrue =
   Printf.sprintf "(function () {@[<v 2>if (%s) {@,return %s;@,}@]@,})()"
                  cond iftrue
 
-let ppf_ifthenelse cond iftrue iffalse =
-  Printf.sprintf "@[<v 0>if (%s) {@;<1 2>@[<v 0>%s@]@,} else {@;<1 2>@[<v 0>%s@]@,}@]"
-                 cond iftrue iffalse
 
 let ppf_sequence exp1 exp2 =
   Printf.sprintf "%s;@,%s"
@@ -370,22 +367,6 @@ let generate_logged_case loc spat binders ctx newctx sbody need_break =
      (if need_break then "@,break;" else ""))
 
 
-(* generate_logged_case implement using
-[insertCaseCode(caseBody,bindings,ctx,newctx,sbody)]
-£4424;caseBody;codeOf(bindings);sbody;break
-case(caseBody); codeOf(bindings); newctx=ctx_push(ctx,bindings); logEvent(LINEOF(432423), "case", newctx);sbody;break
-
-with help of
-
-  if binders = [] then L.log_line (ppf_branch spat binders se) [(L.Exit)]
-  else
-    let typ = match List.rev (Str.split (Str.regexp " ") spat) with
-      | [] -> assert false
-      | x :: xs -> String.sub x 0 (String.length x)
-    in L.log_line (ppf_branch spat binders se) [(L.Exit); (L.ReturnStrip); (L.Add (binders, typ))]
-
-*)
-
 (* LATER: optimize return when it's a value *)
 
 let generate_logged_return loc ctx sbody = 
@@ -396,19 +377,31 @@ let generate_logged_return loc ctx sbody =
      Printf.sprintf "%sreturn %s;%s" token_start sbody token_stop
   | Mode_logged ->
     let id = id_fresh "_return_" in
-    Printf.sprintf "var %s = %s;@,log_event(%s, ctx_push(%s, [{key: \"return_value\", val: %s}]), \"return\");@,return %s; "
+    Printf.sprintf "var %s = %s;@,log_event(%s, ctx_push(%s, [{key: \"#RETURN_VALUE\", val: %s}]), \"return\");@,return %s; "
       id sbody token_loc ctx id id
-(*
-----
-  [insertReturnCode(e,ctx)]
 
-TOKEN(432423);return e
 
-var t=e; logEvent(LINEOF(432423), ctx_push(ctx, {"return",t}), "return"); return t
-----
-*)
 
+let ppf_ifthenelse arg iftrue iffalse =
+  Printf.sprintf "@[<v 0>if (%s) {@;<1 2>@[<v 0>%s@]@,} else {@;<1 2>@[<v 0>%s@]@,}@]"
+                 arg iftrue iffalse
 
+let generate_logged_if loc ctx sintro sarg siftrue siffalse =
+  (* sintro is not empty only in the logged case,
+     it describes the binding of the value describing the argument of the if *)
+  let (token_start, token_stop, token_loc) = token_fresh loc in
+  match !current_mode with
+  | Mode_cmi -> assert false
+  | Mode_unlogged -> 
+     ppf_ifthenelse sarg siftrue siffalse
+  | Mode_line_token ->
+     let sarg_with_token = Printf.sprintf "%s%s%s" token_start sarg token_stop in
+     ppf_ifthenelse sarg_with_token siftrue siffalse
+  | Mode_logged ->
+     let sevent = Printf.sprintf "%slog_event(%s, %s, \"if\");@,"
+        sintro token_loc ctx in
+     let sbody = ppf_ifthenelse sarg siftrue siffalse in
+     sevent ^ sbody
 
 let generate_logged_let loc ids ctx newctx sdecl sbody =
   let (token_start, token_stop, token_loc) = token_fresh loc in
@@ -428,17 +421,6 @@ let generate_logged_let loc ids ctx newctx sdecl sbody =
   | Mode_unlogged -> 
      Printf.sprintf "%s@,%s" sdecl sbody
 
-(*
-
-----
-  [insertLetCode(x,e,ctx,newctx,sbody)]
-
-TOKEN(432423);var x = e;sbody
-
-var x=e; var newctx=ctx_push(ctx,x,e); logEvent(LINEOF(432423), "let", ctx);sbody
-----
-*)
-
 (* LATER: factoriser les bindings *)
 
 let generate_logged_enter loc arg_ids ctx newctx sbody = 
@@ -462,23 +444,6 @@ let generate_logged_enter loc arg_ids ctx newctx sbody =
   let args = String.concat ", " arg_ids in
   Printf.sprintf "%sfunction (%s)%s {@;<1 2>@[<v 0>%s%s@]@,}" shead1 args shead2 sintro sbody
 
-(*
-
-----
-function(x,y) {
-  [isnertEnterCode(bindings,ctx,newctx)]fdqfdsf
-  }
-
-TOKEN(432423);sbody
-
-var newctx = ctx_push(bindings);
-logEvent(LINEOF(432423), newctx, "enter");sbody
-----
-
-may reuse 
-    ppf_function args body
-
-*)
 
 
 
@@ -612,7 +577,7 @@ and js_of_expression_naming_argument_if_non_variable ctx obj name_prefix =
   | Texp_ident (path, ident,  _) -> 
       "", (js_of_path_longident path ident)
   | _ ->  (* generate  var id = sexp;  *)
-      let id = id_fresh "_switch_arg_" in
+      let id = id_fresh name_prefix in
       let sintro = js_of_expression ctx (Dest_assign id) obj in
       (sintro ^ "@,"), id
 
@@ -757,7 +722,14 @@ and js_of_expression ctx dest e =
     (* ppf_ifthen (js_of_expression e1) (js_of_expression e2) *)
   | Texp_ifthenelse (e1, e2, Some e3) ->
      reject_inline dest;
-     ppf_ifthenelse (inline_of_wrap e1) (js_of_expression ctx dest e2) (js_of_expression ctx dest e3)
+     let (sintro, se1) = 
+       match !current_mode with
+       | Mode_logged -> 
+           let (sintro, sobj) = js_of_expression_naming_argument_if_non_variable ctx e1 "_if_arg_" in 
+           (sintro, sobj)
+       | _ ->  ("", inline_of_wrap e1)
+       in
+     generate_logged_if loc ctx sintro se1 (js_of_expression ctx dest e2) (js_of_expression ctx dest e3)
   | Texp_sequence (e1, e2) -> 
      ppf_sequence (inline_of_wrap e1) (js_of_expression ctx dest e2)
   | Texp_while      (cd, body)        -> out_of_scope loc "while"
diff --git a/navig-driver.js b/navig-driver.js
index 122aee3..bb69e8d 100644
--- a/navig-driver.js
+++ b/navig-driver.js
@@ -173,14 +173,8 @@ $("#navigation_step").change(function(e) {
 });
 
 $("#button_run").click(function() {
- // TODO: revive the try-catch
- // try {
- readSourceParseAndRun();
- //  $("#action_output").html("Run successful!");
- // } catch(e){
- //   $("#action_output").html("Error during the run.");
- //   throw(e);   
- // };
+  var message = readSourceParseAndRun();
+  $("#action_output").html(message);
   var timeoutID = window.setTimeout(function() { $("#run_output").html(""); }, 1000);
 });
 
@@ -555,15 +549,29 @@ function run() {
 }
 
 function readSourceParseAndRun() {
+   var message = "";
    var code = source.getValue();
    //console.log(code);
    // TODO handle parsing error
-   parsedTree = esprima.parse(code, {loc:true});
+   try {
+     parsedTree = esprima.parse(code, {loc:true});
+   } catch (e) {
+     return "Parse error";
+   }
    // console.log(parsedTree);
-   // TODO write the parser
+ 
+   // TODO handle out of scope errors
    program = esprimaToAST(parsedTree);
    // console.log(program);
-   run();
+
+   try {
+     run();
+   } catch (e) {
+     throw e;
+     // LATER: return "Error during the run.";
+   }
+   
+   return "Run successful!";
 }
 
 
@@ -571,13 +579,13 @@ function readSourceParseAndRun() {
 
 
 // interpreter file displayed initially
-viewFile(tracer_files[0].file);
+// -- viewFile(tracer_files[0].file);
+viewFile("JsInterpreter.ml");
 
 //$timeout(function() {codeMirror.refresh();});
 
 
 
-
 // -------------- Testing ----------------
 
 // usage: testParse("var x = 3");
-- 
GitLab