(* Fnlib.sml. Library functions *)exception Impossible of string;fun fatalError s = raise(Impossible s);fun getOption NONE = fatalError "getOption" | getOption (SOME a) = a;fun fst (x, y) = x;fun snd (x, y) = y;fun incr r = r := !r + 1;fun decr r = r := !r - 1;fun mapFrom f n [] = [] | mapFrom f n (x :: xs) = f n x :: mapFrom f (n+1) xs;fun map2 f [] [] = [] | map2 f (x :: xs) (y :: ys) = f x y :: map2 f xs ys | map2 f _ _ = fatalError "map2: lists of different length";fun appFrom f n [] = () | appFrom f n (x :: xs) = (f n x : unit; appFrom f (n+1) xs);fun app2 f [] [] = () | app2 f (x::xs) (y::ys) = (f x y : unit; app2 f xs ys) | app2 f _ _ = fatalError "app2: lists of different length";fun revApp f [] = () | revApp f (h::t) = (revApp f t;f h);fun foldL f a [] = a | foldL f a (x::xs) = foldL f (f x a) xs;fun foldL_zip f a [] [] = a | foldL_zip f a (x::xs) (y::ys) = foldL_zip f (f x y a) xs ys | foldL_zip f a _ _ = fatalError "foldL_zip: lists of different length";fun foldL_map f g a [] = a | foldL_map f g a (x::xs) = foldL_map f g (f (g x) a) xs;fun foldR f a [] = a | foldR f a (x::xs) = f x (foldR f a xs);fun foldR1 f [] = fatalError "foldR1: an empty argument" | foldR1 f [x] = x | foldR1 f (x::xs) = f x (foldR1 f xs);fun foldR_map f g e [] = e | foldR_map f g e (x::xs) = f (g x) (foldR_map f g e xs);fun map_fields f [] = [] | map_fields f ((lab, t) :: xs) = (lab, f t) :: map_fields f xs;fun all_fields f [] = true | all_fields f ((_, t) :: xs) = (f t) andalso all_fields f xs;fun exists_field f [] = false | exists_field f ((_, t) :: xs) = (f t) orelse exists_field f xs;fun app_field f [] = () | app_field f ((_, t) :: xs) = (f t : unit; app_field f xs);fun member k [] = false | member k (x :: xs) = if k = x then true else member k xs;fun exists p [] = false | exists p (a::xs) = p a orelse exists p xs;fun remove k [] = [] | remove k (x :: xs) = if k = x then xs else x :: (remove k xs);fun drop p [] = [] | drop p (x :: xs) = if p x then (drop p xs) else x :: (drop p xs);fun lookup k [] = raise Subscript | lookup k ((a, v) :: xs) = if k = a then v else lookup k xs;(* The vector vec must be sorted *)fun binlookup (name : string) (vec : (string * 'a) Vector.vector) = let fun search a b = if a > b then raise Subscript else let val i = (a+b) div 2 val (key, v) = Vector.sub(vec, i) in if name < key then search a (i-1) else if key < name then search (i+1) b else v end in search 0 (Vector.length vec - 1) end;fun choose p [] = raise Subscript | choose p (a::xs) = if p a then a else choose p xs;fun find p [] = raise Subscript | find p ((a, v) :: xs) = if p a then v else find p xs;fun foldInt f a n = if n <= 0 then a else f n (foldInt f a (n-1));fun duplicates [] = false | duplicates (x :: xs) = member x xs orelse duplicates xs;fun stringToLower s = CharVector.tabulate(size s, fn i => Char.toLower(CharVector.sub(s, i)));fun for f i j = if i > j then () else (f i : unit; for f (i+1) j);fun zip2 [] [] = [] | zip2 [] (y :: ys) = fatalError "zip2" | zip2 (x :: xs) [] = fatalError "zip2" | zip2 (x :: xs) (y :: ys) = (x, y) :: zip2 xs ys;
(* Fnlib.sml. Library functions *)
exception Impossible of string;
fun fatalError s = raise(Impossible s);
fun getOption NONE = fatalError "getOption"
| getOption (SOME a) = a
;
fun fst (x, y) = x;
fun snd (x, y) = y;
fun incr r = r := !r + 1;
fun decr r = r := !r - 1;
fun mapFrom f n [] = []
| mapFrom f n (x :: xs) = f n x :: mapFrom f (n+1) xs
;
fun map2 f [] [] = []
| map2 f (x :: xs) (y :: ys) = f x y :: map2 f xs ys
| map2 f _ _ = fatalError "map2: lists of different length"
;
fun appFrom f n [] = ()
| appFrom f n (x :: xs) = (f n x : unit; appFrom f (n+1) xs)
;
fun app2 f [] [] = ()
| app2 f (x::xs) (y::ys) = (f x y : unit; app2 f xs ys)
| app2 f _ _ = fatalError "app2: lists of different length"
;
fun revApp f [] = ()
| revApp f (h::t) = (revApp f t;f h)
;
fun foldL f a [] = a
| foldL f a (x::xs) = foldL f (f x a) xs
;
fun foldL_zip f a [] [] = a
| foldL_zip f a (x::xs) (y::ys) = foldL_zip f (f x y a) xs ys
| foldL_zip f a _ _ = fatalError "foldL_zip: lists of different length"
;
fun foldL_map f g a [] = a
| foldL_map f g a (x::xs) = foldL_map f g (f (g x) a) xs
;
fun foldR f a [] = a
| foldR f a (x::xs) = f x (foldR f a xs)
;
fun foldR1 f [] = fatalError "foldR1: an empty argument"
| foldR1 f [x] = x
| foldR1 f (x::xs) = f x (foldR1 f xs)
;
fun foldR_map f g e [] = e
| foldR_map f g e (x::xs) = f (g x) (foldR_map f g e xs)
;
fun map_fields f [] = []
| map_fields f ((lab, t) :: xs) = (lab, f t) :: map_fields f xs
;
fun all_fields f [] = true
| all_fields f ((_, t) :: xs) =
(f t) andalso all_fields f xs
;
fun exists_field f [] = false
| exists_field f ((_, t) :: xs) =
(f t) orelse exists_field f xs
;
fun app_field f [] = ()
| app_field f ((_, t) :: xs) = (f t : unit; app_field f xs)
;
fun member k [] = false
| member k (x :: xs) =
if k = x then true else member k xs
;
fun exists p [] = false
| exists p (a::xs) = p a orelse exists p xs
;
fun remove k [] = []
| remove k (x :: xs) =
if k = x then xs else x :: (remove k xs)
;
fun drop p [] = []
| drop p (x :: xs) =
if p x then (drop p xs) else x :: (drop p xs)
;
fun lookup k [] = raise Subscript
| lookup k ((a, v) :: xs) =
if k = a then v else lookup k xs
;
(* The vector vec must be sorted *)
fun binlookup (name : string) (vec : (string * 'a) Vector.vector) =
let fun search a b =
if a > b then raise Subscript
else
let val i = (a+b) div 2
val (key, v) = Vector.sub(vec, i)
in
if name < key then search a (i-1)
else if key < name then search (i+1) b
else v
end
in search 0 (Vector.length vec - 1) end;
fun choose p [] = raise Subscript
| choose p (a::xs) =
if p a then a else choose p xs
;
fun find p [] = raise Subscript
| find p ((a, v) :: xs) =
if p a then v else find p xs
;
fun foldInt f a n = if n <= 0 then a else f n (foldInt f a (n-1))
;
fun duplicates [] = false
| duplicates (x :: xs) = member x xs orelse duplicates xs
;
fun stringToLower s =
CharVector.tabulate(size s, fn i => Char.toLower(CharVector.sub(s, i)));
fun for f i j =
if i > j then () else (f i : unit; for f (i+1) j)
;
fun zip2 [] [] = []
| zip2 [] (y :: ys) = fatalError "zip2"
| zip2 (x :: xs) [] = fatalError "zip2"
| zip2 (x :: xs) (y :: ys) = (x, y) :: zip2 xs ys
;