Merge new log into current generator

generator/js_of_ast.ml

@@ -82,8 +82,7 @@ let ppf_let_in decl exp =
   in ppf_lambda_wrap s
 
 let ppf_function args body=
-  Printf.sprintf "function (%s) {@;<1 2>@[<v 0>return %s;@]@,}"
-                 args body
+  (L.log_line (Printf.sprintf "function (%s) {" args) [L.Enter; (L.CreateCtx args)]) ^ (Printf.sprintf "@;<1 2>@[<v 0>return %s;@]@,}" body)
 
 let ppf_apply f args =
   Printf.sprintf "%s(%s)"
@@ -248,12 +247,12 @@ and js_of_structure_item ?(mod_gen=[]) s =
 and js_of_branch ?(mod_gen=[]) b obj =
   let spat, binders = js_of_pattern ~mod_gen b.c_lhs obj in
   let se = js_of_expression ~mod_gen b.c_rhs in
-  if binders = "" then ppf_branch spat binders se
+  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.Add (binders, typ))
+    in L.log_line (ppf_branch spat binders se) [(L.Exit); (L.ReturnStrip); (L.Add (binders, typ))]
     
 and js_of_expression ?(mod_gen=[]) e =
   let locn = e.exp_loc in
@@ -280,8 +279,8 @@ and js_of_expression ?(mod_gen=[]) e =
               |> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope locn "optional apply arguments" | Some ei -> js_of_expression ~mod_gen ei) in
     let se = js_of_expression ~mod_gen f in
     if is_infix f sl' && List.length exp_l = 2
-    then L.log_line (ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl))) (L.ApplyInfix (se, (List.hd sl), (List.hd (List.tl sl))))
-    else L.log_line (ppf_apply se (String.concat ", " sl)) (L.ApplyFunc (se, (String.concat ", " sl)))
+    then ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl))
+    else ppf_apply se (String.concat ", " sl)
 
   | Texp_match (exp, l, [], Total) ->
      let se = js_of_expression ~mod_gen exp in

generator/log.ml

@@ -33,10 +33,12 @@ sig
          
   type ctx_operation =
     | Add of ident * typ
-    | ApplyInfix of func * ident * ident
-    | ApplyFunc  of func * ident
+    | CreateCtx of ident
+    | ReturnStrip
+    | Enter
+    | Exit
 
-  val log_line : string -> ctx_operation -> string
+  val log_line : string -> ctx_operation list -> string
   val strip_log_info : string -> string
   val logged_output : string -> string
   val unlogged_output : string -> string
@@ -51,8 +53,10 @@ struct
          
   type ctx_operation =
     | Add of ident * typ
-    | ApplyInfix of func * ident * ident
-    | ApplyFunc  of func * ident
+    | CreateCtx of ident
+    | ReturnStrip
+    | Enter
+    | Exit
                  
   type token_info = ctx_operation
                                   
@@ -97,30 +101,36 @@ struct
     if l.[len - 1] = '|' then extract (len - 2) 0
     else None
 
-  let log_line str ctx =
-    let token, tokenized = bind_token str in
-    Hashtbl.replace info_tbl token ctx;
-    tokenized
+  let log_line str ctxls =
+    let log_ctx str ctx =
+      let token, tokenized = bind_token str in
+      Hashtbl.replace info_tbl token ctx;
+      tokenized in
+    List.fold_left log_ctx str ctxls
 
   let strip_log_info s =
     global_replace token_re "" s
 
+  (* Helper for lines that looks for all tokens in a line, and
+   returns a tuple containing a list of tokens and the detokenized line *)
+  let rec line_token_extractor acc pos l =
+    match search_forward token_re l pos with
+      | exception Not_found -> (acc, l)
+      | _  ->  let m = matched_string l in
+               let npos = match_beginning () in
+               let m_len = String.length m in
+               let nl = global_replace (regexp m) "" l in
+               let nacc = (Some (G.token_of_string (String.sub m 1 (m_len - 2)))) :: acc in
+               line_token_extractor nacc npos nl
+
   let lines s =
-    let append_token lines =
-      List.fold_left
-        (fun acc x -> match search_forward token_re x 0 with
-                      | exception Not_found -> (None, x) :: acc
-                      | _  ->  let m = matched_string x in
-                              let m_len = String.length m
-                              in (Some (G.token_of_string (String.sub m 1 (m_len - 2))) , String.sub x 0 (String.length x - m_len)) :: acc
-        ) [] lines in
     let end_line_markers s =
       let rec build start = match (search_forward endline_re s start) with
         | n -> n :: build (n + 1)
         | exception not_Found -> []
       in build 0 in
     let lines_list = snd @@ List.fold_left (fun (st, acc) ed -> (ed, String.sub s st (ed - st) :: acc)) (0, []) (end_line_markers s)
-    in append_token lines_list
+    in List.fold_left (fun acc x -> (line_token_extractor [] 0 x) :: acc ) [] lines_list
 
   (* Wrap the entire logged version in a callable run_trm function, and add a call to return run(code). *)
   (* Assumes entry point called run *)
@@ -133,10 +143,13 @@ struct
     (* i is line number of line preceding return *)
     let rec aux i = function
       | [] -> ()
-      | (None, str)   :: xs ->
+      | (None :: tks, str) :: xs ->
+          Buffer.add_string buf str;
+          aux (i + 1) xs
+      | ([], str)   :: xs ->
           Buffer.add_string buf str;
           aux (i + 1) xs
-      | (Some l, str) :: xs -> let log_info =
+      | (Some l :: tks, str) :: xs ->
           let pad = 
             let len = String.length str in
             let rec repeat n x = if n = 0 then "" else x ^ repeat (n - 1) x in
@@ -146,21 +159,41 @@ struct
                 else i - 1
               else len 
             in repeat (aux 1) " " in
-        match Hashtbl.find info_tbl l with
-          | Add (id, typ)   -> 
-              let ctx_processing id =
-                 let rec aux = function
-                   | [] -> ""
-                   | x :: xs -> "\n" ^ pad ^ "ctx_push(ctx, \"" ^ x ^  "\", " ^ x ^ ", \"value\");" ^ aux xs
-                 in id |> to_format |> Format.sprintf
-                       |> global_replace (regexp "var ") "" |> split (regexp ", ") |> List.map (fun x -> List.hd (split (regexp " = ") x))
-                       |> aux
-              in ctx_processing id ^ "\n" ^ pad ^ "log("^ string_of_int i ^" , ctx, " ^ typ ^ ");\n"
-          | ApplyInfix (f, e1, e2) -> ""  (* Actually not used *)
-          | ApplyFunc  (f, args) ->   ""  (* Actually not used *)
-        in Buffer.add_string buf log_info; 
-            Buffer.add_string buf (strip_log_info str);
-            aux (i + 1) xs
+          match Hashtbl.find info_tbl l with
+            | Add (id, typ)   -> 
+                let ctx_processing id =
+                   let rec aux = function
+                     | [] -> ""
+                     | x :: xs -> "\n" ^ pad ^ "ctx = ctx_push(ctx, \"" ^ x ^  "\", " ^ x ^ ", \"value\");" ^ aux xs
+                   in id |> to_format |> Format.sprintf
+                         |> global_replace (regexp "var ") "" |> split (regexp ", ") |> List.map (fun x -> List.hd (split (regexp " = ") x))
+                         |> aux
+                in Buffer.add_string buf @@ ctx_processing id ^ "\n" ^ pad ^ "log("^ string_of_int i ^" , ctx, " ^ typ ^ ");";
+                   aux i ((tks, str) :: xs)
+            | CreateCtx args ->
+                (* Creates new context and logs arguments. *)
+                let argslist = split (regexp ", ") args in
+                Buffer.add_string buf str;
+                Buffer.add_string buf ("\n" ^ pad ^ "var ctx = ctx_empty();");
+                (* Logging needs changing so we can use args actual name instead of t *)
+                List.map (fun x -> Buffer.add_string buf ("\n" ^ pad ^ "ctx = ctx_push(ctx, \"" ^ x ^ "\", " ^ x ^ ", \"term\");") ) argslist;
+                (* Find way to trickle actual function name in log call? *)
+                Buffer.add_string buf ("\n" ^ pad ^ "log(" ^ string_of_int (i + 1)  ^ ", ctx, \"function\");");
+                aux i ((tks, str) :: xs)
+            | ReturnStrip ->
+                let strsplit = split (regexp "return") str in
+                if List.length strsplit > 1 then
+                  let nstr = (List.nth strsplit 0) ^ "return returnres;" in
+                  Buffer.add_string buf ((List.nth strsplit 0) ^ "var returnres =" ^ (List.nth strsplit 1));
+                  aux i ((tks, nstr) :: xs)
+                else
+                  aux i ((tks, str) :: xs)
+            | Enter -> 
+                Buffer.add_string buf ("\n" ^ pad ^ "log_custom({line:" ^ string_of_int (i + 1) ^ ", type: \"enter\"});");
+                aux (i+1) xs
+            | Exit ->
+                Buffer.add_string buf ("\n" ^ pad ^ "log_custom({line:" ^ string_of_int (i + 1) ^ ", type: \"exit\"});");
+                aux i ((tks, str) :: xs)
     in aux 0 ls; Buffer.contents buf
                                  
   let logged_output s =

generator/log_source.js

@@ -30,19 +30,19 @@ var eval_ = function (expr) {
      return (function () {
        switch (expr.type) {
        case "Const": var n = expr.value;
-                     ctx_push(ctx, "n", n, "value");
+                     ctx = ctx_push(ctx, "n", n, "value");
                      log(26 , ctx, "Const");
                      return n;
 
        case "Add": var ls = expr.left, rs = expr.right;
-                   ctx_push(ctx, "ls", ls, "value");
-                   ctx_push(ctx, "rs", rs, "value");
+                   ctx = ctx_push(ctx, "ls", ls, "value");
+                   ctx = ctx_push(ctx, "rs", rs, "value");
                    log(28 , ctx, "Add");
                    return call_wrap(29, ls, eval_) + call_wrap(29, rs, eval_);
 
        case "Sub": var ls = expr.left, rs = expr.right;
-                   ctx_push(ctx, "ls", ls, "value");
-                   ctx_push(ctx, "rs", rs, "value");
+                   ctx = ctx_push(ctx, "ls", ls, "value");
+                   ctx = ctx_push(ctx, "rs", rs, "value");
                    log(30 , ctx, "Sub");
                    return (function() {
                         log_custom({line: 31, type: "enter"});
@@ -52,19 +52,19 @@ var eval_ = function (expr) {
                     }());
 
        case "Mul": var ls = expr.left, rs = expr.right;
-                   ctx_push(ctx, "ls", ls, "value");
-                   ctx_push(ctx, "rs", rs, "value");
+                   ctx = ctx_push(ctx, "ls", ls, "value");
+                   ctx = ctx_push(ctx, "rs", rs, "value");
                    log(32 , ctx, "Mul");
                    return call_wrap(33, line, eval_) * call_wrap(33, rs, eval_);
 
        case "Div": var ls = expr.left, rs = expr.right;
-                   ctx_push(ctx, "ls", ls, "value");
-                   ctx_push(ctx, "rs", rs, "value");
+                   ctx = ctx_push(ctx, "ls", ls, "value");
+                   ctx = ctx_push(ctx, "rs", rs, "value");
                    log(34 , ctx, "Div");
                    return call_wrap(35, ls, eval_) / call_wrap(35, rs, eval_);
 
        case "Pop": var s = expr.stack;
-                   ctx_push(ctx, "s", s, "value");
+                   ctx = ctx_push(ctx, "s", s, "value");
                    log(36 , ctx, "Pop");
                    return Stack.pop(call_wrap(37, s, evals));
        }
@@ -82,8 +82,8 @@ var evals = function (sexpr) {
     case "Emp": 
                 return {type: "Stack.N"};
     case "Push": var v = sexpr.value, s = sexpr.stack;
-                 ctx_push(ctx, "v", v, "value");
-                 ctx_push(ctx, "s", s, "value");
+                 ctx = ctx_push(ctx, "v", v, "value");
+                 ctx = ctx_push(ctx, "s", s, "value");
                  log(48 , ctx, "Push");
                  return Stack.push(call_wrap(49, v, eval_), call_wrap(49, s, evals));
 

navig.html

@@ -35,7 +35,8 @@
 <script src="sparray.js"></script>
 <script type = "text/javascript" src="source.js"></script>
 <script src="interp.js"></script>
-<script src="generator/tests/log_source.js"></script>
+<script src="generator/tests/calc.log.js"></script>
+<!--<script src="generator/tests/log_source.js"></script>-->
 
 <style>
 .source_div {