From 70efe70f3a2c9b0e64f9700d4026817f9a08b12a Mon Sep 17 00:00:00 2001
From: charguer <arthur@chargueraud.org>
Date: Wed, 25 Nov 2015 13:46:58 +0100
Subject: [PATCH] new ctx branch
---
generator/js_of_ast.ml | 80 ++++++++++++++++++++++++++++++++++++
generator/tests/testctx.ml | 83 ++++++++++++++++++++++++++++++++++++++
2 files changed, 163 insertions(+)
create mode 100644 generator/tests/testctx.ml
diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index cc503d8..08f74de 100644
--- a/generator/js_of_ast.ml
+++ b/generator/js_of_ast.ml
@@ -381,3 +381,83 @@ let to_javascript module_name typedtree =
let pre_res = ppf_module_wrap module_name content in
(L.logged_output pre_res, L.unlogged_output pre_res, pre_res)
+
+
+(*
+ctx_empty
+ctx_push(ctx, bindings) where bindings = [ { key:"ls", val:ls}, { key:"xs", val:xs } ]
+
+example:
+ ctx321 = ctx_push(ctx320, bindings); log(|line|, ctx321, "ctx_push")
+
+
+ enter (or call) => current ctx plus arguments of the call
+ return (was exit) => current ctx plus return value
+ let (on the "in") => current ctx plus new binding
+ case => current ctx plus bound variables
+
+ type token_info = ctx_operation * ctx
+
+
+ if ==> viewed as match with case true/false.
+
+
+ctx_empty is passed on each structure_item
+on each ctx extension, we need a fresh name (enter, let, match_branch)
+(for return values, do the extension on the fly)
+
+
+ return f(x);
+translates as
+ var v213 = f(x);
+ log(|line|, ctx_push(ctx320, {key: "return", val: v213}), "return")
+
+
+
+ match v with | None -> x | Some y -> y
+translates as
+ function() {
+
+
+
+----------------------
+ let f ... =
+ match ...
+
+=>
+ switch
+ case:
+ return;
+
+----------------------
+ let f ... =
+ match .. ->
+ match ...
+
+=>
+ return
+
+----------------------
+ let x = match ... in ...
+=>
+ switch ...
+ case:
+ x = ..; break;
+ case:
+ x = ..; break;
+
+
+----------------------
+ let x =
+ match .. ->
+ match .. ->
+=>
+ would not work without wrapping
+
+----------------------
+
+ f (match ...)
+=>
+ requires A-normalization
+
+*)
\ No newline at end of file
diff --git a/generator/tests/testctx.ml b/generator/tests/testctx.ml
new file mode 100644
index 0000000..48eef10
--- /dev/null
+++ b/generator/tests/testctx.ml
@@ -0,0 +1,83 @@
+
+let testa x =
+ x
+
+let testb x =
+ let x = x in x
+
+let testc x =
+ let y = x in
+ let x = y+1 in
+ x+y
+
+let testd x =
+ let f x =
+ let y = x in y in
+ f x
+
+let teste x =
+ let y =
+ let z = x in z in
+ y
+
+let testf x =
+ let f a =
+ let y = a in x+y in
+ f x
+
+
+let testg x =
+ if x then 1 else 0
+
+
+
+
+
+let test0 =
+ match Some 3 with
+ | None -> 2
+ | Some y -> y
+
+
+let test1 on =
+ let x =
+ match on with
+ | None -> 0
+ | Some n -> n
+ in
+ 2*x
+
+let test2 v =
+ let x =
+ let x = 3 in x+1
+ in
+ x
+
+
+let test3 x =
+ let x =
+ match x with
+ | None -> 1
+ | Some x -> x+2
+ in
+ x
+
+let test4 x =
+ let y = x+1 in
+ let x x = x in
+ x (let x = y in x)
+
+let test5 x =
+ match x with
+ | None -> 0
+ | Some x -> let x = x+x in x+1
+
+(*
+
+let test6 =
+ function z -> match z with (x,y) -> x
+*)
+(*
+let test6 (x,y) =
+ x
+ *)
\ No newline at end of file
--
GitLab