add a test case

Author: bobzhang

jscomp/test/build.ninja

@@ -704,6 +704,7 @@ build test/tfloat_record_test.cmi test/tfloat_record_test.cmj : cc test/tfloat_r
 build test/ticker.cmi test/ticker.cmj : cc test/ticker.ml | $stdlib
 build test/to_string_test.cmi test/to_string_test.cmj : cc test/to_string_test.ml | test/mt.cmj $stdlib
 build test/topsort_test.cmi test/topsort_test.cmj : cc test/topsort_test.ml | $stdlib
+build test/tramp_fib.cmi test/tramp_fib.cmj : cc test/tramp_fib.ml | test/mt.cmj $stdlib
 build test/tscanf_test.cmi test/tscanf_test.cmj : cc test/tscanf_test.ml | test/mt.cmj test/mt_global.cmj test/testing.cmj $stdlib
 build test/tuple_alloc.cmi test/tuple_alloc.cmj : cc test/tuple_alloc.ml | $stdlib
 build test/typeof_test.cmi test/typeof_test.cmj : cc test/typeof_test.ml | test/mt.cmj $stdlib

jscomp/test/tramp_fib.js

@@ -0,0 +1,107 @@
+'use strict';
+
+var Mt = require("./mt.js");
+
+var suites = {
+  contents: /* [] */0
+};
+
+var test_id = {
+  contents: 0
+};
+
+function eq(loc, x, y) {
+  return Mt.eq_suites(test_id, suites, loc, x, y);
+}
+
+function fib(n, k) {
+  if (n === 0 || n === 1) {
+    return k(1);
+  } else {
+    return {
+            TAG: /* Suspend */1,
+            _0: (function () {
+                return fib(n - 1 | 0, (function (v0) {
+                              return fib(n - 2 | 0, (function (v1) {
+                                            return k(v0 + v1 | 0);
+                                          }));
+                            }));
+              })
+          };
+  }
+}
+
+var u = fib(10, (function (x) {
+        return {
+                TAG: /* Continue */0,
+                _0: x
+              };
+      }));
+
+function iter(_bounce) {
+  while(true) {
+    var bounce = _bounce;
+    if (!bounce.TAG) {
+      return bounce._0;
+    }
+    _bounce = bounce._0();
+    continue ;
+  };
+}
+
+function isEven(n) {
+  if (n !== 0) {
+    if (n !== 1) {
+      return {
+              TAG: /* Suspend */1,
+              _0: (function () {
+                  return isOdd(n - 1 | 0);
+                })
+            };
+    } else {
+      return {
+              TAG: /* Continue */0,
+              _0: false
+            };
+    }
+  } else {
+    return {
+            TAG: /* Continue */0,
+            _0: true
+          };
+  }
+}
+
+function isOdd(n) {
+  if (n !== 0) {
+    if (n !== 1) {
+      return isEven(n - 1 | 0);
+    } else {
+      return {
+              TAG: /* Continue */0,
+              _0: true
+            };
+    }
+  } else {
+    return {
+            TAG: /* Continue */0,
+            _0: false
+          };
+  }
+}
+
+eq("File \"tramp_fib.ml\", line 56, characters 6-13", iter(u), 89);
+
+eq("File \"tramp_fib.ml\", line 58, characters 6-13", iter(isEven(20000)), true);
+
+Mt.from_pair_suites("File \"tramp_fib.ml\", line 60, characters 23-30", suites.contents);
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.fib = fib;
+exports.u = u;
+exports.iter = iter;
+exports.isEven = isEven;
+exports.isOdd = isOdd;
+/* u Not a pure module */

jscomp/test/tramp_fib.ml

@@ -0,0 +1,60 @@
+[@@@bs.config {flags = [|"-w";"a";"-bs-noassertfalse"|]}]
+
+let suites :  Mt.pair_suites ref  = ref []
+let test_id = ref 0
+let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y 
+
+
+type 'a bounce = Continue of 'a | Suspend of (unit -> 'a bounce [@bs])
+(* https://eli.thegreenplace.net/2017/on-recursion-continuations-and-trampolines/ *)
+(* http://gallium.inria.fr/seminaires/transparents/20141027.Frederic.Bour.pdf *)
+(* http://www.usrsb.in/blog/blog/2012/08/12/bouncing-pythons-generators-with-a-trampoline/ *)
+(* http://glat.info/jscheck/tomrec.html *)
+let rec fib n k = 
+  match n with 
+  | 0 | 1 -> 
+    (* k (Continue 1) [@bs] *)
+    (* Suspend (fun [@bs]() -> k (Continue 1 ) [@bs]) *)
+    k 1 [@bs]
+  | _ ->
+    Suspend (fun [@bs] () ->
+      fib (n-1) (fun [@bs] v0 ->
+        fib (n-2) (fun [@bs] v1 ->
+          k (v0 + v1) [@bs] 
+        (* match v0,v1 with
+        | Continue v0, Continue v1 ->  *)
+          (* k (Continue (v0 + v1)) [@bs] *)
+          (* Suspend (fun [@bs]() -> k (Continue (v0 + v1)) [@bs]) *)
+        (* | _ -> assert false   *)
+          (* FIXME: this branch completly gone*)
+        )
+      )
+    ) 
+
+let u = fib 10 (fun [@bs] x -> Continue x)    
+
+
+let rec iter (bounce : 'a bounce) : 'a = 
+  match bounce with 
+  | Continue v -> v 
+  | Suspend f -> iter (f () [@bs])
+
+
+(* first it needs to be tailcall *)
+let rec isEven n = 
+  match n with 
+  | 0 -> Continue true
+  | 1 -> Continue false  
+  | _ -> Suspend (fun [@bs] () -> isOdd (n - 1))
+and isOdd n = 
+  match n with 
+  | 0 -> Continue false
+  | 1 -> Continue true
+  | _ -> 
+    isEven (n - 1)
+    (* Suspend (fun [@bs] () -> isEven (n - 1))       *)
+;; eq __LOC__ (iter u) 89  
+
+;; eq __LOC__  (isEven 20_000 |. iter )  true
+
+;; Mt.from_pair_suites __LOC__ !suites