| 1 | datatype ('a, 'b) either = LEFT of 'a | RIGHT of 'b |
| 2 | |
| 3 | fun eval thunk = |
| 4 | LEFT (thunk ()) handle e => RIGHT e |
| 5 | |
| 6 | datatype 'a status = LAZY of unit -> 'a promise |
| 7 | | EAGER of ('a, exn) either |
| 8 | withtype 'a promise = 'a status ref ref |
| 9 | |
| 10 | fun lazy exp = |
| 11 | ref (ref (LAZY exp)) |
| 12 | |
| 13 | fun delay exp = |
| 14 | lazy (fn () => ref (ref (EAGER (eval exp)))) |
| 15 | |
| 16 | fun force promise = |
| 17 | case !(!promise) |
| 18 | of EAGER (LEFT x) => x |
| 19 | | EAGER (RIGHT x) => raise x |
| 20 | | LAZY exp => |
| 21 | let |
| 22 | val promise' = exp () |
| 23 | in |
| 24 | (case !(!promise) |
| 25 | of LAZY _ => (!promise := !(!promise') ; |
| 26 | promise' := !promise) |
| 27 | | _ => ()) |
| 28 | ; force promise |
| 29 | end |
| 30 | |
| 31 | exception Assertion |
| 32 | |
| 33 | fun check (b, e) = if b then () else raise e |
| 34 | fun verify b = check (b, Assertion) |
| 35 | |
| 36 | val () = |
| 37 | let |
| 38 | val r = delay (fn () => (print "hi\n" ; 1)) |
| 39 | val s = lazy (fn () => r) |
| 40 | val t = lazy (fn () => s) |
| 41 | in |
| 42 | verify (1 = force t) |
| 43 | ; verify (1 = force r) |
| 44 | end |