1(* Copyright University of Cambridge 1999 *)
2(* Author: Michael Norrish *)
3(* $Id$ *)
4
5structure seq :> seq = struct
6datatype 'a seq =
7  LNIL |
8  LCONS of ('a * 'a seq) |
9  LDELAYREF of  'a seq ref |
10  LDELAYED of (unit -> 'a seq)
11
12fun delay f = LDELAYREF (ref (LDELAYED f))
13fun force s =
14  case s of LDELAYREF r =>
15    (case !r of LDELAYED f =>
16      let
17        val new = f ()
18      in
19        r := new; new
20      end
21    | x => x)
22  | x => x
23
24fun cons x xs = LCONS(x, xs)
25
26fun null LNIL = true
27  | null (LCONS _) = false
28  | null (LDELAYED _) = raise Fail "seq - shouldn't happen"
29  | null (x as LDELAYREF _) = null (force x)
30
31fun cases LNIL = NONE
32  | cases (LCONS (e, es)) = SOME (e, es)
33  | cases (LDELAYED f) = raise Fail "seq - shouldn't happen"
34  | cases (x as LDELAYREF _) = cases (force x)
35
36fun fcases LNIL  (n, c) = n
37  | fcases (LCONS(e, es)) (n, c) = c (e, es)
38  | fcases (LDELAYED f) _ = raise Fail "seq - shouldn't happen"
39  | fcases x (n, c) = fcases (force x) (n, c)
40
41fun append LNIL x = x
42  | append (LCONS (e, es)) x = delay (fn () => LCONS (e, append es x))
43  | append (LDELAYED f) x = raise Fail "seq - shouldn't happen"
44  | append x y = delay (fn () => append (force x) y)
45
46fun result x = LCONS(x, LNIL)
47
48fun fresult f = let
49  fun listfn () = let
50    val element = f ()
51  in
52    case element of
53      NONE => LNIL
54    | SOME x => LCONS(x, delay listfn)
55  end
56in
57  delay listfn
58end
59
60fun map f LNIL = LNIL
61  | map f (LCONS(e, es)) = delay (fn () => LCONS(f e, map f es))
62  | map f (LDELAYED x) = raise Fail "seq - shouldn't happen"
63  | map f x = delay (fn () => map f (force x))
64
65fun mapPartial f s =
66  case s of
67    LNIL => LNIL
68  | LCONS(e, es) => delay (fn () => case f e of
69                                      NONE => mapPartial f es
70                                    | SOME x => LCONS(x, mapPartial f es))
71  | LDELAYED x => raise Fail "seq - shouldn't happen"
72  | x => delay (fn () => mapPartial f (force x))
73
74fun filter P = mapPartial (fn x => if P x then SOME x else NONE)
75
76fun flatten LNIL = LNIL
77  | flatten (LCONS(e, es)) = delay (fn () => append e (flatten es))
78  | flatten (LDELAYED _) = raise Fail "seq - shouldn't happen"
79  | flatten x = delay (fn () => flatten (force x))
80
81fun bind LNIL f = LNIL
82  | bind (LCONS(e, es)) f = delay (fn () => append (f e) (flatten (map f es)))
83  | bind (LDELAYED _) _ = raise Fail "seq - shouldn't happen"
84  | bind x f = delay (fn () => bind (force x) f)
85
86val empty = LNIL
87
88fun hd LNIL = raise Fail "seq - hd of nil"
89  | hd (LCONS(e, _)) = e
90  | hd (LDELAYED _) = raise Fail "seq - shouldn't happen"
91  | hd x = hd (force x)
92
93fun tl LNIL = raise Fail "seq - tl of nil"
94  | tl (LCONS(e, es)) = force es
95  | tl (LDELAYED _) = raise Fail "seq - shouldn't happen"
96  | tl x = tl (force x)
97
98fun fromList [] = LNIL
99  | fromList (e::es) = delay (fn () => LCONS(e, fromList es))
100
101fun take' 0 _ = []
102  | take' _ LNIL = []
103  | take' n (LCONS(e, es)) = e::take' (n - 1) es
104  | take' _ (LDELAYED _) = raise Fail "seq.take - shouldn't happen"
105  | take' n x = take' n (force x)
106
107fun take n l =
108  if n < 0 then raise Fail "seq.take - negative amount"
109  else take' n l
110
111fun drop' 0 s = s
112  | drop' _ LNIL = LNIL
113  | drop' n (LCONS(e, es)) = drop' (n - 1) es
114  | drop' _ (LDELAYED _) = raise Fail "seq.drop - shouldn't happen"
115  | drop' n x = drop' n (force x)
116
117fun drop n l =
118  if n < 0 then raise Fail "seq.drop - negative amount"
119  else drop' n l
120
121fun length LNIL = 0
122  | length (LCONS(e, es)) = 1 + length (force es)
123  | length (LDELAYED _) = raise Fail "seq - shouldn't happen"
124  | length x = length (force x)
125
126end
127