ml_logging

generator/Makefile

-#
+	#
 # Usage:
 #    make all  # not implemented yet, will build everything
 #    make full    # build *.log.js, *.unlog.js, *.token.js
@@ -54,15 +54,17 @@ ASSEMBLY_JS_FILES := \
 	JsInit.unlog.js \
 	JsInterpreterMonads.unlog.js \
 	JsInterpreter.log.js
-ASSEMBLY_JS := $(STDLIB_DIR)/stdlib.js $(addprefix tests/jsref/,$(ASSEMBLY_JS_FILES));
+ASSEMBLY_JS := $(STDLIB_DIR)/stdlib.js $(addprefix tests/jsref/,$(ASSEMBLY_JS_FILES))
 
 
 ###############################################################
 
-DISPLAYED_JS_FILES := \
-	JsInterpreter.unlog.js
+DISPLAYED_FILES := \
+	JsInterpreter.ml
+
+DISPLAYED := $(addprefix tests/jsref/,$(DISPLAYED_FILES))
+
 
-DISPLAYED_JS := $(addprefix tests/jsref/,$(DISPLAYED_JS_FILES));
 
 
 ###############################################################
@@ -70,7 +72,7 @@ DISPLAYED_JS := $(addprefix tests/jsref/,$(DISPLAYED_JS_FILES));
 
 all: everything
 
-.PHONY: all clean .log.js .unlog.js .token.js
+.PHONY: all clean .log.js .unlog.js .token.js .mlloc.js
    # all gen log unlog 
 
 # Do not delete intermediate files.
@@ -132,13 +134,13 @@ tests/%.log.js: tests/%.ml main.byte stdlib tests/%.cmi
 tests/%.unlog.js: tests/%.ml main.byte stdlib tests/%.cmi
 	./main.byte -mode unlog -I $(<D) $<
 
-tests/%.token.js: tests/%.ml main.byte stdlib tests/%.cmi
+tests/%.token.js tests/%.mlloc.js: tests/%.ml main.byte stdlib tests/%.cmi
 	./main.byte -mode token -I $(<D) $<
 
 ##### Rule for lineof.js
 
-$(JSREF_PATH)/lineof.js: lineof.byte $(JSREF_ML:.ml=.token.js)
-	./lineof.byte -o $@ $(JSREF_ML:.ml=.token.js)
+$(JSREF_PATH)/lineof.js: lineof.byte $(DISPLAYED:.ml=.token.js) $(DISPLAYED:.ml=.mlloc.js)
+	./lineof.byte -o $@ $(DISPLAYED:.ml=.token.js) $(DISPLAYED:.ml=.mlloc.js)
 
 ##### Rule for assembly.js
 
@@ -149,8 +151,8 @@ $(JSREF_PATH)/assembly.js: assembly.byte $(ASSEMBLY_JS)
 
 ##### Rule for displayed_sources.js
 
-$(JSREF_PATH)/displayed_sources.js: displayed_sources.byte $(DISPLAYED_JS)
-	./displayed_sources.byte -o $@ $(DISPLAYED_JS)
+$(JSREF_PATH)/displayed_sources.js: displayed_sources.byte $(DISPLAYED:.ml=.unlog.js) $(DISPLAYED)
+	./displayed_sources.byte -o $@ $(DISPLAYED:.ml=.unlog.js) $(DISPLAYED)
 
 
 #### maybe useful ??
@@ -186,17 +188,18 @@ stdlib: $(STDLIB_DIR)/stdlib.cmi
 #####################################################################
 # Clean
 
-DIRTY_EXTS := cmi,token.js,log.js,unlog.js,d,ml.d,mli.d,js.pre
+DIRTY_EXTS := cmi,.mlloc.js,token.js,log.js,unlog.js,d,ml.d,mli.d,js.pre
 
 clean_genjs:
 	rm -f $(JSREF_PATH)/lineof.js
 	rm -f $(JSREF_PATH)/assembly.js
 
 clean_tests:
-	bash -c "rm -f $(TESTS_DIR)/*.{$(DIRTY_EXTS)}"
-	bash -c "rm -f $(TESTS_DIR)/$(JSREF_DIR)/*.{$(DIRTY_EXTS)}"
+	bash -c "rm -f $(JSREF_PATH)/*.{$(DIRTY_EXTS)}"
 	bash -c "rm -f $(JSREF_PATH)/.depends"
 
+#	bash -c "rm -f $(TESTS_DIR)/*.{$(DIRTY_EXTS)}"
+
 clean_stdlib:
 	rm -f $(STDLIB_DIR)/*.cmi
 

generator/TODO

 
+NEW NEW TODO
 
+- remove _runs0 from arguments
+- rename the p' variables
 
+- restore button step into / next
+
+- tokens for if statement
+
+- switch,return,call,var generate events, 
 
 
 NEW TODO

generator/displayed_sources.ml

@@ -80,8 +80,8 @@ let hashtbl_keys t =
     takes as argument a list of javascript filenames,
     and create a javascript file with a definition of
     an array called "tracer_files", storing objects with
-    two fields: a filename, and a contents, with newline
-    and quotes properly escaped.
+    two fields: a filename, and a contents, with newline, 
+    quotes and backslashes properly escaped.
 
 
    var tracer_files = [
@@ -141,18 +141,36 @@ let _ =
        output_string outchannel "\n" in
 
 
+   (*---------------------------------------------------*)
+   (* test *)
+
+  (* DEBUG: to test how many backslashes are needed
+  let line = "foo \\n" in
+     let line = Str.global_replace (Str.regexp "\\") "\\\\\\\\" line in
+     print_string  line;
+     print_newline();
+   exit 0;
+  *)
+
    (*---------------------------------------------------*)
    (* include of logged js files *)
 
+
    put "var tracer_files = [";
 
    ~~ List.iter !files (fun filename ->
-      let basename = Filename.chop_suffix (Filename.basename filename) ".unlog.js" in
-      let showed_filename = basename ^ ".js" in
+      let showed_filename = 
+         let short = Filename.basename filename in
+         if (Filename.check_suffix short ".unlog.js") then begin
+            let basename = Filename.chop_suffix short ".unlog.js" in
+            basename ^ ".js" 
+         end else short  (* should be .ml file *)
+         in
       put (Printf.sprintf "\n/* --------------------- %s --------------------- */" showed_filename);
       put_no_endline (Printf.sprintf "  { file: '%s', contents: '" showed_filename);
       let lines = XFile.get_lines filename in
       ~~ List.iter lines (fun line ->
+         let line = Str.global_replace (Str.regexp "\\") "\\\\\\\\" line in
          let line = Str.global_replace (Str.regexp "'") "\\'" line in
          put_no_endline line;
          put_no_endline "\\n";

generator/js_of_ast.ml

@@ -281,6 +281,24 @@ let id_fresh =
   fun prefix -> (incr r; prefix ^ string_of_int !r)
 
 
+(****************************************************************)
+(* TOKEN TO LOC BINDINGS FOR THE ML SOURCE FILES *)
+
+(* Keeps track of the location associated with each token,
+   maps int to (pos*pos).  *)
+
+type pos = { pos_line: int; pos_col: int }
+let token_locs = Hashtbl.create 50 
+
+let pos_of_lexing_pos lexing_pos =
+  let (file, line, char) = Location.get_pos_info lexing_pos in
+  { pos_line = line; pos_col = char } 
+
+let pos_pair_of_loc loc =
+  (pos_of_lexing_pos loc.Location.loc_start,
+   pos_of_lexing_pos loc.Location.loc_end)
+
+
 (****************************************************************)
 (* FRESH TOKEN NAMES *)
 
@@ -289,13 +307,19 @@ let token_basename_ref = ref "no_token_basename_registered"
 let token_register_basename basename =
   token_basename_ref := basename
 
+(* returns a string of the form: ["filename.js", 3425],
+   where 3425 describes the token. *)
+
 let token_fresh =
   let r = ref 0 in
-  fun () -> (incr r; 
+  fun loc -> (
+    incr r; 
+    Hashtbl.add token_locs (!r) (pos_pair_of_loc loc);
     let token_start = Printf.sprintf "@{<%d>" !r in
     let token_stop = "@}" in
-    let token_lineof = Printf.sprintf "lineof(\"%s.js\", %d)" !token_basename_ref !r in  
-    (token_start, token_stop, token_lineof))
+    let token_loc = Printf.sprintf "\"%s.js\", %d" !token_basename_ref !r in 
+    (token_start, token_stop, token_loc))
+
 
 
 (****************************************************************)
@@ -314,10 +338,10 @@ let ctx_initial =
 (****************************************************************)
 (* LOGGED CONSTRUCTORS *)
 
-let generate_logged_case spat binders ctx newctx sbody need_break =
+let generate_logged_case loc spat binders ctx newctx sbody need_break =
   (* Note: binders is a list of pairs of id *)
   (* Note: if binders = [], then newctx = ctx *)
-  let (token_start, token_stop, token_lineof) = token_fresh() in
+  let (token_start, token_stop, token_loc) = token_fresh loc in
   let (shead, sintro) =
     match !current_mode with
     | Mode_cmi -> assert false
@@ -336,7 +360,7 @@ let generate_logged_case spat binders ctx newctx sbody need_break =
         else Printf.sprintf "var %s = ctx_push(%s, %s);@," newctx ctx bindings
       in
       let sintro = Printf.sprintf "%slog_event(%s, %s, \"case\");@,"
-        spreintro token_lineof newctx in
+        spreintro token_loc newctx in
       ("", sintro)
     | Mode_unlogged -> ("", "")
     in
@@ -364,16 +388,16 @@ with help of
 
 (* LATER: optimize return when it's a value *)
 
-let generate_logged_return ctx sbody = 
-  let (token_start, token_stop, token_lineof) = token_fresh() in
+let generate_logged_return loc ctx sbody = 
+  let (token_start, token_stop, token_loc) = token_fresh loc in
   match !current_mode with
   | Mode_cmi -> assert false
   | Mode_unlogged | Mode_line_token ->
      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\", value: %s}]), \"return\");@,return %s; "
-      id sbody token_lineof ctx id id
+    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)]
@@ -386,8 +410,8 @@ var t=e; logEvent(LINEOF(432423), ctx_push(ctx, {"return",t}), "return"); return
 
 
 
-let generate_logged_let ids ctx newctx sdecl sbody =
-  let (token_start, token_stop, token_lineof) = token_fresh() in
+let generate_logged_let loc ids ctx newctx sdecl sbody =
+  let (token_start, token_stop, token_loc) = token_fresh loc in
   match !current_mode with
   | Mode_cmi -> assert false
   | Mode_line_token ->
@@ -400,7 +424,7 @@ let generate_logged_let ids ctx newctx sdecl sbody =
       Printf.sprintf "[%s]" (show_list ", " (List.map mk_binding ids))
     in 
     Printf.sprintf "%s@,var %s = ctx_push(%s, %s);@,log_event(%s, %s, \"let\");@,%s@,"
-      sdecl newctx ctx bindings token_lineof newctx sbody
+      sdecl newctx ctx bindings token_loc newctx sbody
   | Mode_unlogged -> 
      Printf.sprintf "%s@,%s" sdecl sbody
 
@@ -417,8 +441,8 @@ var x=e; var newctx=ctx_push(ctx,x,e); logEvent(LINEOF(432423), "let", ctx);sbod
 
 (* LATER: factoriser les bindings *)
 
-let generate_logged_enter arg_ids ctx newctx sbody = 
-  let (token_start, token_stop, token_lineof) = token_fresh() in
+let generate_logged_enter loc arg_ids ctx newctx sbody = 
+  let (token_start, token_stop, token_loc) = token_fresh loc in
   let (shead1, shead2, sintro) =
     match !current_mode with
     | Mode_cmi -> assert false
@@ -431,7 +455,7 @@ let generate_logged_enter arg_ids ctx newctx sbody =
         Printf.sprintf "[%s]" (show_list ", " (List.map mk_binding arg_ids))
       in 
       let sintro = Printf.sprintf "var %s = ctx_push(%s, %s);@,log_event(%s, %s, \"enter\");@,"
-        newctx ctx bindings token_lineof newctx in
+        newctx ctx bindings token_loc newctx in
       ("", "", sintro)
     | Mode_unlogged -> ("", "", "")
   in
@@ -469,10 +493,10 @@ type dest =
   | Dest_assign of string
   | Dest_inline
 
-let apply_dest ctx dest sbody =
+let apply_dest loc ctx dest sbody =
   match dest with
   | Dest_ignore -> sbody
-  | Dest_return -> generate_logged_return ctx sbody
+  | Dest_return -> generate_logged_return loc ctx sbody
   | Dest_assign id -> Printf.sprintf "var %s = %s;" id sbody
   | Dest_inline -> sbody
 
@@ -572,7 +596,7 @@ and js_of_branch ctx dest b eobj =
   let newctx = if binders = [] then ctx else ctx_fresh() in
   let sbody = js_of_expression newctx dest b.c_rhs in
   let need_break = (dest <> Dest_return) in
-  generate_logged_case spat binders ctx newctx sbody need_break 
+  generate_logged_case b.c_lhs.pat_loc spat binders ctx newctx sbody need_break 
      
 and js_of_expression_inline_or_wrap ctx e = 
   try 
@@ -595,15 +619,16 @@ and js_of_expression_naming_argument_if_non_variable ctx obj name_prefix =
 and js_of_expression ctx dest e =
   let inline_of_wrap = js_of_expression_inline_or_wrap ctx in (* shorthand *)
   let loc = e.exp_loc in
+  let apply_dest' = apply_dest loc in
   match e.exp_desc with
 
   | Texp_ident (path, ident,  _) -> 
       let sexp = js_of_path_longident path ident in
-      apply_dest ctx dest sexp
+      apply_dest' ctx dest sexp
 
   | Texp_constant c -> 
       let sexp = js_of_constant c in
-      apply_dest ctx dest sexp
+      apply_dest' ctx dest sexp
 
   | Texp_let (_, vb_l, e) ->
     reject_inline dest;
@@ -645,7 +670,7 @@ and js_of_expression ctx dest e =
       end in
     let newctx = ctx_fresh() in
     let sbody = js_of_expression newctx dest e in
-    let sexp = generate_logged_let ids ctx newctx sdecl sbody in
+    let sexp = generate_logged_let loc ids ctx newctx sdecl sbody in
     sexp
 
   | Texp_function (_, c :: [], Total) ->
@@ -659,8 +684,8 @@ and js_of_expression ctx dest e =
     let arg_ids, body = explore [c.c_lhs] c.c_rhs in
     let newctx = ctx_fresh() in
     let sbody = js_of_expression newctx Dest_return body in
-    let sexp = generate_logged_enter arg_ids ctx newctx sbody in
-    apply_dest ctx dest sexp
+    let sexp = generate_logged_enter loc arg_ids ctx newctx sbody in
+    apply_dest' ctx dest sexp
 
   | Texp_apply (f, exp_l) ->
      (* first check not partial application *)
@@ -696,7 +721,7 @@ and js_of_expression ctx dest e =
         end else begin
            ppf_apply se (String.concat ",@ " sl)
         end in
-     apply_dest ctx dest sexp
+     apply_dest' ctx dest sexp
 
   | Texp_match (obj, l, [], Total) ->
      reject_inline dest;
@@ -708,7 +733,7 @@ and js_of_expression ctx dest e =
 
   | Texp_tuple (tl) -> 
      let sexp = ppf_tuple @@ show_list_f (fun exp -> inline_of_wrap exp) ", " tl in
-     apply_dest ctx dest sexp
+     apply_dest' ctx dest sexp
 
   | Texp_construct (p, cd, el) ->
     let cstr_fullname = string_of_longident p.txt in
@@ -725,7 +750,7 @@ and js_of_expression ctx dest e =
           let expr_strs = List.map (fun exp -> inline_of_wrap exp) el in
           ppf_cstrs_fct cstr_fullname expr_strs
         end in
-    apply_dest ctx dest sexp
+    apply_dest' ctx dest sexp
 
   | Texp_array      (exp_l)           -> ppf_array @@ show_list_f (fun exp -> inline_of_wrap exp) ", " exp_l
   | Texp_ifthenelse (e1, e2, None)    -> out_of_scope loc "if without else"
@@ -741,14 +766,15 @@ and js_of_expression ctx dest e =
     (* ppf_for (ppf_ident id) (js_of_expression st) (js_of_expression ed) fl (js_of_expression body) *)
   | Texp_record     (llde,_)          -> 
       let sexp = ppf_record (List.map (fun (_, lbl, exp) -> (lbl.lbl_name, inline_of_wrap exp)) llde) in
-      apply_dest ctx dest sexp
+      apply_dest' ctx dest sexp
   | Texp_field      (exp, _, lbl)     ->
       let sexp = ppf_field_access (inline_of_wrap exp) lbl.lbl_name in
-      apply_dest ctx dest sexp
+      apply_dest' ctx dest sexp
       
   | Texp_assert      e                -> 
       let sexp = inline_of_wrap e in
       Printf.sprintf "throw %s;" sexp
+      (* TODO: what about apply_dest? *)
 
   | Texp_function (label, cases, Total) when label = "" -> 
       let mk_pat pat_des =

generator/lineof.ml

@@ -208,9 +208,7 @@ let _ =
 *)
 
 
-let generate_lineof_function put =
-   put "var lineof_data = {};";
-   put "var lineof_temp;";
+let generate_lineof_entries put =
    ~~ List.iter !tokens (fun (basename, tokens_start, tokens_stop) ->
      put "   lineof_temp = [];";
      let filename = basename ^ ".js" in
@@ -252,7 +250,7 @@ let generate_lineof_function put =
        }
      }
 
-   let generate_lineof_function output_file =
+   let generate_lineof_entries output_file =
      let aux_pos pos =
        Printf.sprintf "{ line: %d, col: %d }" pos.pos_line pos.pos_col 
        in
@@ -285,12 +283,15 @@ let generate_lineof_function put =
      let output = Format.flush_str_formatter () in
      XFile.put_contents output_file output
       
-  ==> generate_lineof_function output_filename 
+  ==> generate_lineof_entries output_filename 
 *)
 
 
 (*#########################################################################*)
 
+(** The files called *.mlloc.js are appended directly;
+    they come first in the output file.  *)
+
 
 let files = ref ([]:string list)
 let outputfile = ref None
@@ -313,6 +314,7 @@ let _ =
      ("usage: [..other options..] -o lineof.js file1.token.js file2.token.js ..");
    if !files = [] then
      failwith "No input file provided";
+   files := List.rev !files;
    let input_filename1 = List.hd !files in
    let dirname = Filename.dirname input_filename1 in
    let output_filename = 
@@ -321,16 +323,6 @@ let _ =
      | Some f -> f
    in
 
-   (*---------------------------------------------------*)
-   (* processing source files *)
-
-   ~~ List.iter !files (fun filename ->
-     if not (Filename.check_suffix filename ".token.js") then
-       failwith "Input file must be of the form *.token.js";
-     let basename = Filename.chop_suffix (Filename.basename filename) ".token.js" in
-     let input_lines = XFile.get_lines filename in
-     gather_tokens basename input_lines
-   );
 
    (*---------------------------------------------------*)
    (* open output file for writing *)
@@ -340,11 +332,29 @@ let _ =
        output_string outchannel str;
        output_string outchannel "\n" in
 
+   put "var lineof_data = {};";
+   put "var lineof_temp;";
+
+
+   (*---------------------------------------------------*)
+   (* processing source files *)
+
+   ~~ List.iter !files (fun filename ->
+     if (Filename.check_suffix filename ".mlloc.js") then begin
+        let input_lines = XFile.get_lines filename in
+        List.iter put input_lines;
+     end else if (Filename.check_suffix filename ".token.js") then begin
+        let basename = Filename.chop_suffix (Filename.basename filename) ".token.js" in
+        let input_lines = XFile.get_lines filename in
+        gather_tokens basename input_lines
+     end else 
+        failwith "Input file must be of the form *.token.js"
+   );
 
    (*---------------------------------------------------*)
    (* generating output file *)
 
-   generate_lineof_function put;
+   generate_lineof_entries put;
    close_out outchannel;
    Printf.printf "Wrote file: %s\n" output_filename;
 

generator/main.ml

@@ -34,6 +34,7 @@ let _ =
      ]
      (fun f -> files := f :: !files)
      ("usage: [-I dir] [..other options..] file.ml");
+   files := List.rev !files;
    if List.length !files <> 1 then
       failwith "Expects one argument: the filename of the ML source file";
    let sourcefile = List.hd !files in
@@ -42,12 +43,13 @@ let _ =
    let basename = Filename.chop_suffix (Filename.basename sourcefile) ".ml" in
    let dirname = Filename.dirname sourcefile in
    let pathname = if dirname = "" then basename else (dirname ^ "/" ^ basename) in
-   let log_output, unlog_output, token_output =
+   let log_output, unlog_output, token_output, mlloc_output =
      match !outputfile with
      | None -> Filename.concat dirname (basename ^ ".log.js"),
                Filename.concat dirname (basename ^ ".unlog.js"),
-               Filename.concat dirname (basename ^ ".token.js")
-     | Some f -> f ^ ".log.js", f ^ ".unlog.js", f ^ ".token.js"
+               Filename.concat dirname (basename ^ ".token.js"),
+               Filename.concat dirname (basename ^ ".mlloc.js")
+     | Some f -> f ^ ".log.js", f ^ ".unlog.js", f ^ ".token.js", f ^ ".mlloc.js"
    in
 
    (*---------------------------------------------------*)
@@ -61,6 +63,26 @@ let _ =
       then generate_qualified_names := true;
    *)
 
+
+   (*---------------------------------------------------*)
+   (* generation of the mlloc file that binds tokens to positions *)
+
+   let generate_mlloc_file () =
+      let outchannel = open_out mlloc_output in
+      let put str =
+         output_string outchannel str;
+         output_string outchannel "\n" in
+      put "   lineof_temp = [];";
+      let filename = basename ^ ".ml" in
+      ~~ Hashtbl.iter Js_of_ast.token_locs (fun key (pos_start,pos_stop) ->
+        put (Printf.sprintf "   lineof_temp[%d] = [%d,%d,%d,%d];" 
+               key pos_start.pos_line pos_start.pos_col  
+                   pos_stop.pos_line  pos_stop.pos_col);
+      );
+      put (Printf.sprintf "lineof_data[\"%s\"] = lineof_temp;" filename);
+      close_out outchannel;
+      in
+
    (*---------------------------------------------------*)
    (* "reading and typing source file" *)
 
@@ -82,4 +104,8 @@ let _ =
             | _ -> assert false
           in
           file_put_contents output_filename out;
-          Printf.printf "Wrote %s\n" output_filename
+          Printf.printf "Wrote %s\n" output_filename;
+          if !current_mode = Mode_line_token 
+            then generate_mlloc_file()
+
+

navig-driver.js

@@ -72,7 +72,10 @@ var source = "";
 var interpreter = null;
 
 // Initial source code
-var source_file = 'var x = 2;\n';
+var source_file = 'var x = 2;\nx';
+
+var source_file = ' var t = {}; for (var i = 0; i < 3; i++) { t[i] = function() { return i; } }; t[0](); ';
+var source_file = '{}';
 
 
 // --------------- Initialization ----------------
@@ -250,14 +253,23 @@ function previous() { shared_next(-1, 0); }
 function finish() { shared_next(+1, -1); }
 
 
+// --------------- Auxiliary ----------------
+
+function get_file_extension(filename) {
+  var re = /(?:\.([^.]+))?$/;
+  return re.exec(filename)[1];
+}
+
+
 // --------------- Methods ----------------
 
 // load files in CodeMirror view
 var docs = {};
 for (var i = 0; i < tracer_files.length; i++) {
   var file = tracer_files[i].file;
+  var ext = get_file_extension(file);
   var txt = tracer_files[i].contents;
-  docs[file] = CodeMirror.Doc(txt, 'js');
+  docs[file] = CodeMirror.Doc(txt, ext);
 }
 
 function viewFile(file) {
@@ -381,7 +393,7 @@ function ctxToHtml(ctx) {
 
 function itemToHtml(item) {
   var s = '';
-  s += htmlDiv("token: " + item.loc.token + JSON.stringify(item.loc.start) + JSON.stringify(item.loc.end));
+  s += htmlDiv("token: " + item.token + JSON.stringify(item.locByExt));
   s += htmlDiv("type: " + item.type);
   s += ctxToHtml(item.ctx);
   return s;
@@ -390,12 +402,26 @@ function itemToHtml(item) {
 // --------------- Selection view ----------------
 
 function updateSelectionInCodeMirror(codeMirrorObj, loc) {
- if (loc === undefined) {
+  if (loc === undefined) {
+     return; 
+  }
+  var anchor = {line: loc.start.line-1 , ch: loc.start.column };
+  var head = {line: loc.end.line-1, ch: loc.end.column };
+  codeMirrorObj.setSelection(anchor, head);
+}
+
+function updateSelectionInCodeMirrorAccordingToExt(codeMirrorObj, locByExt) {
+  if (locByExt === undefined) {
    return; 
- }
- var anchor = {line: loc.start.line-1 , ch: loc.start.column };
- var head = {line: loc.end.line-1, ch: loc.end.column };
- codeMirrorObj.setSelection(anchor, head);
+  }
+  var ext = get_file_extension(curfile);
+  var loc = locByExt[ext];
+  if (loc === undefined) {
+    console.log("Error: missing loc for " + curfile + " in:");
+    console.log(locByExt);
+    return;
+  }
+  updateSelectionInCodeMirror(codeMirrorObj, loc);
 }
 
 function updateSelection() {
@@ -423,15 +449,15 @@ function updateSelection() {
      updateContext("#disp_ctx", item.heap, item.ctx);
 
      // interpreter code panel
-     viewFile(item.loc.file);
-     //console.log("pos: " + tracer_pos);
+     // TEMPORARILY DISABLED BECAUSE ONLY SINGLE FILE TO TRACE
+     // viewFile(item.loc.file);
 
      var color = '#F3F781';
         // possible to use different colors depending on event type
         // var color = (item.type === 'enter') ? '#F3F781' : '#CCCCCC';
      $('.CodeMirror-selected').css({ background: color });
      $('.CodeMirror-focused .CodeMirror-selected').css({ background: color });
-     updateSelectionInCodeMirror(interpreter, item.loc);
+     updateSelectionInCodeMirrorAccordingToExt(interpreter, item.locByExt);
    }
 
    // navig panel
@@ -572,4 +598,14 @@ readSourceParseAndRun();
 
 function showCurrent() {
   console.log(tracer_items[tracer_pos]);
+};
+
+
+function findToken(token) {
+  for (var i = 0; i < tracer_items.length; i++) {
+    if (tracer_items[i].token == token) {
+      return i;
+    }
+  }
+  return -1;
 };
\ No newline at end of file

tools.js

@@ -3,14 +3,28 @@
 
 // see "generator/lineof.ml" and "lineof.js" 
 function lineof(filename, token) {
-   var d = lineof_data[filename][token];
+   var f = lineof_data[filename];
+   if (f == undefined) {
+     console.log("could not find lineof for " + filename);
+     return;
+   }
+   var d = f[token];
+   if (d == undefined) {
+     console.log("could not find token " + token + " for " + filename);
+     return;
+   }
    return { file: filename,
-            token: token,
             start: {line: d[0], column: d[1]}, 
             end: {line: d[2], column: d[3]} };
 };
 
 
+// ----------- Auxiliary --------------
+
+String.prototype.replaceAt=function(index, character) {
+    return this.substr(0, index) + character + this.substr(index+character.length);
+}
+
 // ----------- Datalog ----------------
 
 var datalog = [];
@@ -19,12 +33,25 @@ function reset_datalog() {
   datalog = [];
 }
 
-function log_event(loc, ctx, type) {
+// filename assumed to be of js extension
+function log_event(filename, token, ctx, type) {
   // TODO populate state with object_heap, env_record_heap, fresh_locations, and populate env
-  var event = {loc : loc, ctx : ctx, type : type, state: {}, env: {}};
+
+  // compute "foo.ml" from "foo.js"
+  var len = filename.length;
+  var mlfilename = filename.replaceAt(len-2, "m");
+  mlfilename = mlfilename.replaceAt(len-1, "l");
+
+  var jsloc = lineof(filename, token);
+  var mlloc = lineof(mlfilename, token);
+
+  var event = { token: token, locByExt: { "ml": mlloc, "js": jsloc },
+                ctx : ctx, type : type, state: {}, env: {}};
   datalog.push(event);
 }
 
+
+
 // ----------- Context ----------------