10 struct |
10 struct |
11 |
11 |
12 (* Standard exception for TFL. *) |
12 (* Standard exception for TFL. *) |
13 exception ERR of {module:string,func:string, mesg:string}; |
13 exception ERR of {module:string,func:string, mesg:string}; |
14 fun UTILS_ERR{func,mesg} = ERR{module = "Utils",func=func,mesg=mesg}; |
14 fun UTILS_ERR{func,mesg} = ERR{module = "Utils",func=func,mesg=mesg}; |
15 |
|
16 local |
|
17 fun info_string s {module,func,mesg} = |
|
18 (s^" at "^module^"."^func^":\n"^mesg^"\n") |
|
19 in |
|
20 val ERR_string = info_string "Exception raised" |
|
21 val MESG_string = info_string "Message" |
|
22 end; |
|
23 |
|
24 fun Raise (e as ERR sss) = (TextIO.output(TextIO.stdOut, ERR_string sss); |
|
25 raise e) |
|
26 | Raise e = raise e; |
|
27 |
15 |
28 |
16 |
29 (* Simple combinators *) |
17 (* Simple combinators *) |
30 |
18 |
31 fun C f x y = f y x |
19 fun C f x y = f y x |
56 | it ((a::rst1),(b::rst2)) = f a b (it (rst1,rst2)) |
44 | it ((a::rst1),(b::rst2)) = f a b (it (rst1,rst2)) |
57 | it _ = raise UTILS_ERR{func="itlist2",mesg="different length lists"} |
45 | it _ = raise UTILS_ERR{func="itlist2",mesg="different length lists"} |
58 in it (L1,L2) |
46 in it (L1,L2) |
59 end; |
47 end; |
60 |
48 |
61 fun mapfilter f alist = itlist (fn i=>fn L=> (f i::L) handle _ => L) alist []; |
|
62 |
|
63 fun pluck p = |
49 fun pluck p = |
64 let fun remv ([],_) = raise UTILS_ERR{func="pluck",mesg = "item not found"} |
50 let fun remv ([],_) = raise UTILS_ERR{func="pluck",mesg = "item not found"} |
65 | remv (h::t, A) = if p h then (h, rev A @ t) else remv (t,h::A) |
51 | remv (h::t, A) = if p h then (h, rev A @ t) else remv (t,h::A) |
66 in fn L => remv(L,[]) |
52 in fn L => remv(L,[]) |
67 end; |
53 end; |
68 |
|
69 fun front_back [] = raise UTILS_ERR{func="front_back",mesg="empty list"} |
|
70 | front_back [x] = ([],x) |
|
71 | front_back (h::t) = |
|
72 let val (L,b) = front_back t |
|
73 in (h::L,b) |
|
74 end; |
|
75 |
54 |
76 fun take f = |
55 fun take f = |
77 let fun grab(0,L) = [] |
56 let fun grab(0,L) = [] |
78 | grab(n, x::rst) = f x::grab(n-1,rst) |
57 | grab(n, x::rst) = f x::grab(n-1,rst) |
79 in grab |
58 in grab |
84 | zip3 _ _ _ = raise UTILS_ERR{func="zip3",mesg="different lengths"}; |
63 | zip3 _ _ _ = raise UTILS_ERR{func="zip3",mesg="different lengths"}; |
85 |
64 |
86 |
65 |
87 fun can f x = (f x ; true) handle _ => false; |
66 fun can f x = (f x ; true) handle _ => false; |
88 fun holds P x = P x handle _ => false; |
67 fun holds P x = P x handle _ => false; |
89 |
|
90 |
|
91 (* Set ops *) |
|
92 nonfix mem; (* Gag Barf Choke *) |
|
93 fun mem eq_func i = |
|
94 let val eqi = eq_func i |
|
95 fun mm [] = false |
|
96 | mm (a::rst) = eqi a orelse mm rst |
|
97 in mm |
|
98 end; |
|
99 |
|
100 fun mk_set eq_func = |
|
101 let val mem = mem eq_func |
|
102 fun mk [] = [] |
|
103 | mk (a::rst) = if (mem a rst) then mk rst else a::(mk rst) |
|
104 in mk |
|
105 end; |
|
106 |
|
107 (* All the elements in the first set that are not also in the second set. *) |
|
108 fun set_diff eq_func S1 S2 = filter (fn x => not (mem eq_func x S2)) S1 |
|
109 |
68 |
110 |
69 |
111 fun sort R = |
70 fun sort R = |
112 let fun part (m, []) = ([],[]) |
71 let fun part (m, []) = ([],[]) |
113 | part (m, h::rst) = |
72 | part (m, h::rst) = |