82379
|
1 |
(* Author: Pascal Stoop, ETH Zurich
|
|
2 |
Author: Andreas Lochbihler, Digital Asset *)
|
|
3 |
|
|
4 |
signature LAZY =
|
|
5 |
sig
|
|
6 |
type 'a lazy;
|
|
7 |
val lazy : (unit -> 'a) -> 'a lazy;
|
|
8 |
val force : 'a lazy -> 'a;
|
|
9 |
val peek : 'a lazy -> 'a option
|
|
10 |
val termify_lazy :
|
|
11 |
(string -> 'typerep -> 'term) ->
|
|
12 |
('term -> 'term -> 'term) ->
|
|
13 |
(string -> 'typerep -> 'term -> 'term) ->
|
|
14 |
'typerep -> ('typerep -> 'typerep -> 'typerep) -> ('typerep -> 'typerep) ->
|
|
15 |
('a -> 'term) -> 'typerep -> 'a lazy -> 'term -> 'term;
|
|
16 |
end;
|
|
17 |
|
|
18 |
structure Lazy : LAZY =
|
|
19 |
struct
|
|
20 |
|
|
21 |
datatype 'a content =
|
|
22 |
Delay of unit -> 'a
|
|
23 |
| Value of 'a
|
|
24 |
| Exn of exn;
|
|
25 |
|
|
26 |
datatype 'a lazy = Lazy of 'a content ref;
|
|
27 |
|
|
28 |
fun lazy f = Lazy (ref (Delay f));
|
|
29 |
|
|
30 |
fun force (Lazy x) = case !x of
|
|
31 |
Delay f => (
|
|
32 |
let val res = f (); val _ = x := Value res; in res end
|
|
33 |
handle exn => (x := Exn exn; raise exn))
|
|
34 |
| Value x => x
|
|
35 |
| Exn exn => raise exn;
|
|
36 |
|
|
37 |
fun peek (Lazy x) = case !x of
|
|
38 |
Value x => SOME x
|
|
39 |
| _ => NONE;
|
|
40 |
|
|
41 |
fun termify_lazy const app abs unitT funT lazyT term_of T x _ =
|
|
42 |
app (const "Code_Lazy.delay" (funT (funT unitT T) (lazyT T)))
|
|
43 |
(case peek x of SOME y => abs "_" unitT (term_of y)
|
|
44 |
| _ => const "Pure.dummy_pattern" (funT unitT T));
|
|
45 |
|
|
46 |
end;
|