diff options
| -rw-r--r-- | stdlib/source/lux/codata/thunk.lux | 38 | ||||
| -rw-r--r-- | stdlib/test/test/lux/codata/thunk.lux | 29 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 1 |
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] |