diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index eefa1c9afcd8a9ff0eb58a48a8d3ee6ccdd9ae40..e3d3f909231dd691672b27c1ec8a97790bf5041b 100644
--- a/generator/js_of_ast.ml
+++ b/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
diff --git a/generator/log.ml b/generator/log.ml
index f42cb47d6baca93ce0ee1ba015fe520f15f51ce2..a6a20992989445a03406e5d9a5945ca2f1b8112e 100644
--- a/generator/log.ml
+++ b/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 =
diff --git a/generator/log_source.js b/generator/log_source.js
index ced5c44b1e979454f94a41d4713a74b3dbfea686..e6b188c420afa7a96cabe8259593f1dd366a5c10 100644
--- a/generator/log_source.js
+++ b/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));
diff --git a/navig.html b/navig.html
index e41a3de93ce3ec87ddb9be35f2faa935ce420ff6..1763eabf197f25f6277ae8721447f881b27542bd 100644
--- a/navig.html
+++ b/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 {