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