From dad4c35a80ba01c4090d66fc762f5fce0b0d7ac9 Mon Sep 17 00:00:00 2001
From: Dmitry Boulytchev <dboulytchev@gmail.com>
Date: Thu, 17 Oct 2019 15:30:50 +0300
Subject: [PATCH] Fixed bug with mutable closures in interpret (not really ---
 up to closure recursion)

---
 regression/Makefile         |  4 ++--
 regression/orig/test068.log |  3 +++
 regression/test068.expr     | 19 +++++++++++++++++++
 regression/test068.input    |  1 +
 src/Language.ml             | 11 ++++++-----
 5 files changed, 31 insertions(+), 7 deletions(-)
 create mode 100644 regression/orig/test068.log
 create mode 100644 regression/test068.expr
 create mode 100644 regression/test068.input

diff --git a/regression/Makefile b/regression/Makefile
index aa3113c79..7afe4d838 100644
--- a/regression/Makefile
+++ b/regression/Makefile
@@ -8,9 +8,9 @@ check: $(TESTS)
 
 $(TESTS): %: %.expr
 	@echo $@
-	$(RC) $< && cat $@.input | ./$@ 2> /dev/null > $@.log && diff $@.log orig/$@.log
+	$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
 	cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
-	cat $@.input | $(RC) -s $< 2> /dev/null > $@.log && diff $@.log orig/$@.log
+	cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
 
 clean:
 	$(RM) test*.log *.s *~ $(TESTS)
diff --git a/regression/orig/test068.log b/regression/orig/test068.log
new file mode 100644
index 000000000..a2a5aca89
--- /dev/null
+++ b/regression/orig/test068.log
@@ -0,0 +1,3 @@
+> 1
+800
+800
diff --git a/regression/test068.expr b/regression/test068.expr
new file mode 100644
index 000000000..781da7ad6
--- /dev/null
+++ b/regression/test068.expr
@@ -0,0 +1,19 @@
+fun lazy (f) {
+  local flag = 0, value = 0;
+
+  return fun () {
+    if flag
+    then return value
+    else
+      value := f ();
+      flag  := 1;
+      return value
+    fi
+  }
+}
+
+local l = lazy (fun () {write (1); return 800});
+local x = read ();
+
+write (l ());
+write (l ())
\ No newline at end of file
diff --git a/regression/test068.input b/regression/test068.input
new file mode 100644
index 000000000..7ed6ff82d
--- /dev/null
+++ b/regression/test068.input
@@ -0,0 +1 @@
+5
diff --git a/src/Language.ml b/src/Language.ml
index dd1e5c821..596ef0334 100644
--- a/src/Language.ml
+++ b/src/Language.ml
@@ -295,8 +295,8 @@ module Expr =
     (* The type of configuration: a state, an input stream, an output stream,
        and a stack of values
     *)
-    @type 'a value  = ('a, 'a value State.t) Value.t with show,html
-    @type 'a config = 'a value State.t * int list * int list * 'a value list with show,html
+    @type 'a value  = ('a, 'a value State.t array) Value.t with show, html
+    @type 'a config = 'a value State.t * int list * int list * 'a value list with show, html
     (* The type for expressions. Note, in regular OCaml there is no "@type..."
        notation, it came from GT.
     *)
@@ -411,7 +411,7 @@ module Expr =
       in
       match expr with
       | Lambda (args, body) ->
-         eval (st, i, o, Value.Closure (args, body, st) ::vs) Skip k        
+         eval (st, i, o, Value.Closure (args, body, [|st|]) :: vs) Skip k        
       | Scope (defs, body) ->
          let vars, body, bnds =
            List.fold_left
@@ -442,7 +442,7 @@ module Expr =
          let v =
            match State.eval st x with
            | Value.FunRef (_, args, body, level) ->
-              Value.Closure (args, body, State.prune st level)
+              Value.Closure (args, body, [|State.prune st level|])
            | v -> v
          in
          eval (st, i, o, v :: vs) Skip k
@@ -468,8 +468,9 @@ module Expr =
              | Value.Builtin name ->
                 Builtin.eval (st, i, o, vs') es name
              | Value.Closure (args, body, closure) ->
-                let st' = State.push (State.leave st closure) (State.from_list @@ List.combine args es) (List.map (fun x -> x, true) args) in
+                let st' = State.push (State.leave st closure.(0)) (State.from_list @@ List.combine args es) (List.map (fun x -> x, true) args) in
                 let st'', i', o', vs'' = eval (st', i, o, []) Skip body in
+                closure.(0) <- st'';
                 (State.leave st'' st, i', o', match vs'' with [v] -> v::vs' | _ -> Value.Empty :: vs')                      
              | _ -> invalid_arg (Printf.sprintf "callee did not evaluate to a function: %s" (show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") f))
             ))]))