diff --git a/generator/Makefile b/generator/Makefile
index ab8f794ce3b2ab55d3121d0610e67a12ef8ce189..9e5a4f00b61f96b31e62aff39b24b42b4a1c7ea3 100644
--- a/generator/Makefile
+++ b/generator/Makefile
@@ -51,12 +51,15 @@ tests/%.ml.d: tests/%.ml
$(OCAMLDEP) -I $(<D) $< | $(DEPSED) > $@
tests/%.cmi tests/%.unlog.js: tests/%.ml main.byte stdlib
- ./main.byte -I $(<D) $<
+ ./main.byte -mode unlog -I $(<D) $<
tests/%.log.js: tests/%.ml tests/%.cmi main.byte stdlib
- ./main.byte -I $(<D) -log $<
+ ./main.byte -mode log -I $(<D) $<
-tests: $(ML_TESTS:.ml=.log.js)
+tests/%.token.js: tests/%.ml tests/%.cmi main.byte stdlib
+ ./main.byte -mode token -I $(<D) $<
+
+tests: $(ML_TESTS:.ml=.log.js) $(ML_TESTS:.ml=.token.js)
tests/lambda: tests/lambda/Lambda.log.js
tests/jsref: tests/jsref/JsInterpreter.log.js
@@ -64,7 +67,7 @@ tests/jsref: tests/jsref/JsInterpreter.log.js
clean_stdlib:
rm -f $(STD_DIR)/*.cmi
-DIRTY_EXTS := cmi,js.pre,js,d
+DIRTY_EXTS := cmi,token.js,js,d
clean_tests:
rm -f $(TEST_DIR)/*.{$(DIRTY_EXTS)}
rm -f $(TEST_DIR)/lambda/*.{$(DIRTY_EXTS)}
diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index f6a80a38a88afc3d62da958fcceda0f544ca0e71..098d259e97863a91046f7d23a538c4fda4255cbc 100644
--- a/generator/js_of_ast.ml
+++ b/generator/js_of_ast.ml
@@ -226,6 +226,14 @@ let id_fresh =
fun prefix -> (incr r; prefix ^ string_of_int !r)
+(****************************************************************)
+(* FRESH TOKEN NAMES *)
+
+let token_fresh =
+ let r = ref 0 in
+ fun () -> (incr r; Printf.sprintf "#%d#" !r)
+
+
(****************************************************************)
(* CONTEXTS *)
@@ -245,11 +253,11 @@ let ctx_initial =
let generate_logged_case spat binders ctx newctx sbody need_break =
(* Note: binders is a list of pairs of id *)
(* Note: if binders = [], then newctx = ctx *)
+ let token = token_fresh () in
let sintro =
match !current_mode with
- | Mode_line_token
+ | Mode_line_token -> ""
| Mode_logged ->
- let token = "123" in
let ids = List.map fst binders in
let mk_binding x =
Printf.sprintf "{key: \"%s\", val: %s}" x x
@@ -266,7 +274,9 @@ let generate_logged_case spat binders ctx newctx sbody need_break =
| Mode_unlogged -> ""
in
let sbinders = ppf_match_binders binders in
- (Printf.sprintf "@[<v 0>%s:@;<1 2>@[<v 0>%s%s%s%s@]@]" spat sbinders sintro sbody
+ (Printf.sprintf "@[<v 0>%s%s:@;<1 2>@[<v 0>%s%s%s%s@]@]"
+ (match !current_mode with Mode_line_token -> token | _ -> "")
+ spat sbinders sintro sbody
(if need_break then "@,break;" else ""))
@@ -289,12 +299,13 @@ with help of
(* LATER: optimize return when it's a value *)
let generate_logged_return ctx sbody =
+ let token = token_fresh () in
match !current_mode with
- | Mode_line_token
+ | Mode_line_token ->
+ Printf.sprintf "%sreturn %s;" token sbody
| Mode_logged ->
let id = id_fresh "_return_" in
- let token = "12" in
- Printf.sprintf "var %s = %s;@,log_event(lineof(%s), ctx_push(%s, {\"return_value\", %s}), \"return\");@,return %s@,"
+ Printf.sprintf "var %s = %s;@,log_event(lineof(%s), ctx_push(%s, {\"return_value\", %s}), \"return\");@,return %s"
id sbody token ctx id id
| Mode_unlogged ->
Printf.sprintf "return %s;" sbody
@@ -312,10 +323,11 @@ var t=e; logEvent(LINEOF(432423), ctx_push(ctx, {"return",t}), "return"); return
let generate_logged_let ids ctx newctx sdecl sbody =
+ let token = token_fresh () in
match !current_mode with
- | Mode_line_token
+ | Mode_line_token ->
+ Printf.sprintf "%s%s@,%s" sdecl token sbody
| Mode_logged ->
- let token = "42" in
let mk_binding x =
Printf.sprintf "{key: \"%s\", val: %s}" x x
in
@@ -341,11 +353,11 @@ 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 = token_fresh () in
let sintro =
match !current_mode with
- | Mode_line_token
+ | Mode_line_token -> token
| Mode_logged ->
- let token = "51" in
let mk_binding x =
Printf.sprintf "{key: \"%s\", val: %s}" x x
in
diff --git a/generator/main.ml b/generator/main.ml
index 36379757bc7f2a04d7700fcf4ff3e5f8376ce3f1..da2b344632e6eea24e9cf2098774faacfa4e8580 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -23,11 +23,10 @@ let _ =
"includes a directory where to look for interface files");
("-o", Arg.String (fun s -> outputfile := Some s), "set the output file name");
("-debug", Arg.Set debug, "trace the various steps");
- ("-log", Arg.Set logging, "generate file with logging")
+ ("-mode", Arg.String (fun s -> set_current_mode s), "current mode: unlog, log, or token")
]
(fun f -> files := f :: !files)
("usage: [-I dir] [..other options..] file.ml");
- current_mode := if !logging then Mode_logged else Mode_unlogged;
if List.length !files <> 1 then
failwith "Expects one argument: the filename of the ML source file";
let sourcefile = List.hd !files in
@@ -35,12 +34,12 @@ let _ =
failwith "The file name must be of the form *.ml";
let basename = Filename.chop_suffix (Filename.basename sourcefile) ".ml" in
let dirname = Filename.dirname sourcefile in
- let log_output, unlog_output, pre_output =
+ let log_output, unlog_output, token_output =
match !outputfile with
| None -> Filename.concat dirname (basename ^ ".log.js"),
Filename.concat dirname (basename ^ ".unlog.js"),
- Filename.concat dirname (basename ^ ".js.pre")
- | Some f -> f ^ ".log.js", f ^ ".unlog.js", f ^ ".js.pre"
+ Filename.concat dirname (basename ^ ".token.js")
+ | Some f -> f ^ ".log.js", f ^ ".unlog.js", f ^ ".token.js"
in
(*---------------------------------------------------*)
@@ -53,5 +52,9 @@ let _ =
in
let out = Js_of_ast.to_javascript modulename typedtree1 in
- let output_filename = if !logging then log_output else unlog_output in
+ let output_filename = match !current_mode with
+ | Mode_unlogged -> unlog_output
+ | Mode_logged -> log_output
+ | Mode_line_token -> token_output
+ in
file_put_contents output_filename out
diff --git a/generator/params.ml b/generator/params.ml
index 852731d4c2d03b7399ee0685fdf164bfe88568aa..c5f42b885be3c673b13ed1dfbf5beb2495075370 100644
--- a/generator/params.ml
+++ b/generator/params.ml
@@ -1,5 +1,4 @@
let debug = ref false
-let logging = ref false
(****************************************************************)
(* MODES *)
@@ -10,3 +9,10 @@ type generate_mode =
| Mode_logged
let current_mode = ref Mode_unlogged
+
+let set_current_mode s =
+ current_mode := match s with
+ | "log" -> Mode_logged
+ | "unlog" -> Mode_unlogged
+ | "token" -> Mode_line_token
+ | _ -> failwith "Invalid mode, chose log, unlog, or token"