Here is some code that implements Scheme-like delay and
force operations.
module: test
author: Matthias Hoelzl
copyright: (c) 1997 Matthias Hoelzl
// A <PROMISE> stores an expression that is to be evaluated later.
// The PROMISE-EXPRESSION is only evaluated the first time a
// promise is forced. This is achieved by storing a thunk, that is
// a method taking no parameters, with the expression to evaluate as
// body in the slot PROMISE-EXPRESSION.
//
define class <promise> (<object>)
slot promise-expression :: <method>,
required-init-keyword: #"promise-expression";
slot evaluated? :: <boolean>,
init-value: #f;
slot saved-value;
end class <promise>;
// The macro DELAY takes an expression as argument and generates
// a promise. It is implemented as a macro because the
// expression must not be evaluated when the DELAY expression
// is encountered.
//
define macro delay
{ delay (?arg:expression) }
=> { make(<promise>,
promise-expression: method () ?arg end method) }
end macro delay;
// If a promise is given to FORCE for the first time it is
// evaluated and the result is saved, otherwise the previously
// computed result is returned.
//
define function force (promise :: <promise>)
unless (promise.evaluated?)
promise.saved-value := promise.promise-expression();
promise.evaluated? := #t;
end unless;
promise.saved-value;
end function force;
// WITH-DELAYED-VARIABLE is used to bind a variable to the
// value of a promise.
//
define macro with-delayed-variable
{ with-delayed-variable (?:variable = ?:expression)
?:body
end }
=> { let ?variable = force(?expression);
?body }
end macro with-delayed-variable;
// This is just a silly function that eats up some time so that the
// result of saving the result of promises can be appreciated.
//
define function slow (i :: <integer>) => (mumbo-jumbo :: <integer>)
if (i <= 0)
1;
else
slow(i - 1) + slow(i - 2) - slow(i - 3) + 1;
end if;
end function slow;
// The following definitions implement lazy lists.
// A <LAZY-PAIR> can hold two components, the second of which
// must be a <PROMISE>.
//
define class <lazy-pair> (<mutable-sequence>)
slot first-element,
required-init-keyword: #"first-element";
slot second-element :: <promise>,
required-init-keyword: #"second-element";
end class <lazy-pair>;
define method lazy-pair
(fst :: <object>,
snd :: <promise>)
=> (pair :: <lazy-pair>);
make(<lazy-pair>,
first-element: fst,
second-element: snd);
end method lazy-pair;
// LAZY-HEAD is the analogon to HEAD.
//
define method lazy-head (lazy-pair :: <lazy-pair>)
lazy-pair.first-element;
end method lazy-head;
define method lazy-head-setter
(new-value :: <object>,
lazy-pair :: <lazy-pair>)
lazy-pair.first-element := new-value;
end method lazy-head-setter;
// When LAZY-TAIL is called on a <LAZY-PAIR> the promise
// is forced.
//
define method lazy-tail (lazy-pair :: <lazy-pair>)
force(lazy-pair.second-element);
end method lazy-tail;
define method lazy-tail-setter
(new-value :: <promise>,
lazy-pair :: <lazy-pair>)
lazy-pair.second-element := new-value;
end method lazy-tail-setter;
// To maintain the invariant that the SECOND-ELEMENT of a
// <LAZY-PAIR> is a <PROMISE>.
//
define method lazy-tail-setter
(new-value :: <object>,
lazy-pair :: <lazy-pair>)
lazy-pair.second-element := delay(new-value);
end method lazy-tail-setter;
// An implementation of the forward iteration protocol
// for lazy lists.
// The value $not-supplied is exported by library Dylan,
// module extensions.
//
define method element
(lazy-list :: <lazy-pair>,
key :: <integer>,
#key default = $not-supplied)
=> (element :: <object>);
if (key = 0)
lazy-list.first-element;
else
if (default == $not-supplied)
element(lazy-list.lazy-tail, key - 1);
else
element(lazy-list.lazy-tail, key - 1, default: default);
end if;
end if;
end method element;
define method element-setter
(new-element :: <object>,
lazy-list :: <lazy-pair>,
key :: <integer>)
=> (element :: <object>);
if (key = 0)
lazy-list.first-element := new-element;
else
element-setter(new-element, lazy-list.lazy-tail, key - 1);
end if;
end method element-setter;
define method next-state
(lazy-list :: <lazy-pair>, state :: <integer>)
=> (new-state :: <integer>);
state + 1;
end method next-state;
define method finished-state?
(lazy-list :: <lazy-pair>, state :: <integer>, limit :: <integer>)
=> (finished-state? :: <boolean>);
state = limit;
end method finished-state?;
define method current-key
(lazy-list :: <lazy-pair>, state :: <integer>)
=> (current-key :: <integer>);
state;
end method current-key;
define method forward-iteration-protocol
(lazy-list :: <lazy-pair>)
=> (initial-state :: <integer>,
limit :: <integer>,
next-state :: <function>,
finished-state? :: <function>,
current-key :: <function>,
current-element :: <function>,
current-element-setter :: <function>,
copy-state :: <function>);
values(0, // Initial State
-1, // Limit
next-state, // Next State
finished-state?, // Finished State?
current-key, // Current Key
element, // Current Element
element-setter, // Current Element Setter
identity); // Copy State
end method forward-iteration-protocol;
define method squares-above
(x :: <integer>)
=> (infinite-list-of-squares :: <lazy-pair>)
lazy-pair(x ^ 2, delay(squares-above(x + 1)));
end method squares-above;
define constant $squares = squares-above(0);
// Some tests.
//
define method main
(name :: <byte-string>, #rest switches)
=> ();
say-line("\nTesting delay and force.");
say-line("========================\n");
let x = delay(slow(25));
let y = delay(say-line("Sorry, I'm late..."));
test-delay(delay(slow(26)));
test-delay(x);
force(y);
force(y); // No output should appear the second time
say-line("\nTesting with-delayed-variable.\n");
let f = delay(method (i :: <integer>) 2 * i end method);
test-delay-let(f);
say-line("\nTesting lazy lists.");
say-line("===================\n");
say-line("Accessing Elements.");
for (i from 0 to 5)
say("square[%D] = %D \tsquare[%D] = %D\n",
i, $squares[i],
i + 6, $squares[i + 6]);
end for;
say("square[100] = %D \tsquare[123] = %D\n",
$squares[100], $squares[123]);
say-line("\nAccessing non existent elements (should signal errors).");
block ()
lazy-pair(1, delay(2))[2];
exception (any-error :: <error>)
say("Caught error of type %=\n", any-error.object-class);
end block;
say-line("\nForward Iteration Protocol.");
for (i in $squares, until: i > 20)
say("square[%D] = %D\n", i, $squares[i]); // This outputs (i^2)^2
end for;
say-line("\nElement Setter.");
for (i from 3 to 6)
$squares[i] := i;
end for;
for (i from 0 to 3)
say("square[%D] = %D \tsquare[%D] = %D\n",
i, $squares[i],
i + 4, $squares[i + 4]);
end for;
exit();
end method main;
define function test-delay (delayed-arg :: <promise>) => ()
say-line("Not evaluated (next output might take some time).");
say("The delayed value is %D.\n", force(delayed-arg));
say-line("Evaluated. Trying again.");
say("The value is still %D (this should have been fast).\n\n",
force(delayed-arg));
end function test-delay;
define function test-delay-let(delayed-arg :: <promise>) => ()
with-delayed-variable (f = delayed-arg)
say("f(1) = %=\n", f(1));
say("f(2) = %=\n", f(2));
say("f(3) = %=\n", f(3));
end with-delayed-variable;
end function test-delay-let;