aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/codata/thunk.lux38
-rw-r--r--stdlib/test/test/lux/codata/thunk.lux29
-rw-r--r--stdlib/test/tests.lux1
3 files changed, 68 insertions, 0 deletions
diff --git a/stdlib/source/lux/codata/thunk.lux b/stdlib/source/lux/codata/thunk.lux
new file mode 100644
index 000000000..2c0db0db5
--- /dev/null
+++ b/stdlib/source/lux/codata/thunk.lux
@@ -0,0 +1,38 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (lux [io]
+ (control monad)
+ (concurrency ["A" atom])
+ [compiler]
+ (macro ["s" syntax #+ syntax:])))
+
+(type: #export (Thunk a)
+ (-> [] a))
+
+(def: #hidden (freeze' generator)
+ (All [a] (-> (-> [] a) (-> [] a)))
+ (let [cache (: (A;Atom (Maybe ($ +0)))
+ (A;atom #;None))]
+ (lambda [_]
+ (case (io;run (A;get cache))
+ (#;Some value)
+ value
+
+ _
+ (let [value (generator [])]
+ (exec (io;run (A;compare-and-swap _ (#;Some value) cache))
+ value))))))
+
+(syntax: #export (freeze expr)
+ (do @
+ [g!arg (compiler;gensym "")]
+ (wrap (list (` (freeze' (lambda [(~ g!arg)] (~ expr))))))))
+
+(def: #export (thaw thunk)
+ (All [a] (-> (Thunk a) a))
+ (thunk []))
diff --git a/stdlib/test/test/lux/codata/thunk.lux b/stdlib/test/test/lux/codata/thunk.lux
new file mode 100644
index 000000000..b8ddee578
--- /dev/null
+++ b/stdlib/test/test/lux/codata/thunk.lux
@@ -0,0 +1,29 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (lux [io]
+ (control monad)
+ (codata ["&" thunk])
+ pipe
+ ["R" random])
+ lux/test)
+
+(test: "Thunks"
+ [left R;nat
+ right R;nat
+ #let [thunk (&;freeze (n.* left right))
+ expected (n.* left right)]]
+ ($_ seq
+ (assert "Thunking does not alter the expected value."
+ (n.= expected
+ (&;thaw thunk)))
+ (assert "Thunks only evaluate once."
+ (and (not (is expected
+ (&;thaw thunk)))
+ (is (&;thaw thunk)
+ (&;thaw thunk))))
+ ))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index d6a21cae4..e30a8cf0a 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -20,6 +20,7 @@
(codata ["_;" cont]
["_;" env]
["_;" state]
+ ["_;" thunk]
(coll ["_;" stream]))
(concurrency ["_;" actor]
["_;" atom]