{----------------------------------------------------------------} {--- My attempt at a translation of the Haskell 1.1 ---} {--- list prelude, "module PreludeList". ---} {----------------------------------------------------------------} list a ::= Nil | Cons a (list a); pair a b ::= Pair a b; tp3 a b c ::= Tp3 a b c; tp4 a b c d ::= Tp4 a b c d; ;; {--------------------------------------------------------} {--- Preliminaries ---} {--------------------------------------------------------} {--------------------------------------------------------} error = error; {--------------------------------------------------------} dot f g x = f (g x); {--------------------------------------------------------} flip f x y = f y x; {--------------------------------------------------------} max x y = case x > y of True -> x; False -> y end; {--------------------------------------------------------} min x y = case x < y of True -> x; False -> y end; {--------------------------------------------------------} {--- PreludeList ---} {--------------------------------------------------------} {--------------------------------------------------------} head l = case l of Cons x xs -> x; Nil -> error end; {--------------------------------------------------------} last l = case l of Nil -> error; Cons x xs -> case xs of Nil -> x; Cons y ys -> last xs end end; {--------------------------------------------------------} tail l = case l of Cons x xs -> xs; Nil -> error end; {--------------------------------------------------------} init l = case l of Nil -> error; Cons x xs -> case xs of Nil -> Nil; Cons y ys -> Cons x (init xs) end end; {--------------------------------------------------------} null l = case l of Nil -> True; Cons x xs -> False end; {--------------------------------------------------------} append l1 l2 = foldr Cons l2 l1; {--------------------------------------------------------} diff = letrec del = \xl y -> case xl of Nil -> Nil; Cons x xs -> case x == y of True -> xs; False -> Cons x (del xs y) end end in foldl del; {--------------------------------------------------------} length = foldl (\n dontCare -> n+1) 0; {--------------------------------------------------------} nth l n = case l of Nil -> error; Cons x xs -> case n == 0 of True -> x; False -> nth xs (n-1) end end; {--------------------------------------------------------} map f l = case l of Nil -> Nil; Cons x xs -> Cons (f x) (map f xs) end; {--------------------------------------------------------} filter p = foldr (\x xs -> case p x of True -> Cons x xs; False -> xs end) Nil; {--------------------------------------------------------} partition p = let select = \x tsfs -> case tsfs of Pair ts fs -> case p x of True -> Pair (Cons x ts) fs; False -> Pair ts (Cons x fs) end end in foldr select (Pair Nil Nil); {--------------------------------------------------------} foldl f z l = case l of Nil -> z; Cons x xs -> foldl f (f z x) xs end; {--------------------------------------------------------} foldl1 f xl = case xl of Nil -> error; Cons x xs -> foldl f x xs end; {--------------------------------------------------------} scanl f q xl = Cons q (case xl of Nil -> Nil; Cons x xs -> scanl f (f q x) xs end); {--------------------------------------------------------} scanl1 f xl = case xl of Nil -> error; Cons x xs -> scanl f x xs end; {--------------------------------------------------------} foldr f z l = case l of Nil -> z; Cons x xs -> f x (foldr f z xs) end; {--------------------------------------------------------} foldr1 f xl = case xl of Nil -> error; Cons x xs -> case xs of Nil -> x; Cons y ys -> f x (foldr1 f xs) end end; {--------------------------------------------------------} scanr f q0 xl = case xl of Nil -> Cons q0 Nil; Cons x xs -> let qs = scanr f q0 xs in case qs of Nil -> error; Cons qsx qsxs -> Cons (f x qsx) qs end end; {--------------------------------------------------------} scanr1 f xl = case xl of Nil -> error; Cons x xs -> let qs = scanr1 f xs in case qs of Nil -> error; Cons qsx qsxs -> Cons (f x qsx) qs end end; {--------------------------------------------------------} iterate f x = Cons x (iterate f (f x)); {--------------------------------------------------------} repeat x = letrec xs = Cons x xs in xs; {--------------------------------------------------------} cycle xs = letrec xss = append xs xss in xss; {--------------------------------------------------------} take n xl = case n == 0 of True -> Nil; False -> case xl of Nil -> Nil; Cons x xs -> Cons x (take (n-1) xs) end end; {--------------------------------------------------------} drop n xl = case n == 0 of True -> xl; False -> case xl of Nil -> Nil; Cons x xs -> drop (n-1) xs end end; {--------------------------------------------------------} splitAt n xl = case n == 0 of True -> Pair Nil xl; False -> case xl of Nil -> Pair Nil Nil; Cons x xs -> case splitAt (n-1) xs of Pair xsp xspp -> Pair (Cons x xsp) xspp end end end; {--------------------------------------------------------} takeWhile p xl = case xl of Nil -> Nil; Cons x xs -> case p x of True -> Cons x (takeWhile p xs); False -> Nil end end; {--------------------------------------------------------} dropWhile p xl = case xl of Nil -> Nil; Cons x xsp -> case p x of True -> dropWhile p xsp; False -> xl end end; {--------------------------------------------------------} span p xs = case xs of Nil -> Pair Nil Nil; Cons x xsp -> case p x of False -> Pair Nil xs; True -> case span p xsp of Pair ys zs -> Pair (Cons x ys) zs end end end; {--------------------------------------------------------} break p = span (dot not p); {--------------------------------------------------------} {- lines, words, unlines and unwords -} {--------------------------------------------------------} nub xl = case xl of Nil -> Nil; Cons x xs -> Cons x (nub (filter (\a -> not (a == x)) xs)) end; {--------------------------------------------------------} reverse = foldl (flip Cons) Nil; {--------------------------------------------------------} and = foldr (\a b -> a & b) True; {--------------------------------------------------------} or = foldr (\a b -> a | b) True; {--------------------------------------------------------} any p = dot or (map p); {--------------------------------------------------------} all p = dot and (map p); {--------------------------------------------------------} elem = dot any (\a b -> a == b); {--------------------------------------------------------} notElem = dot all (\a b -> not (a == b)); {--------------------------------------------------------} sum = foldl (\a b -> a + b) 0; {--------------------------------------------------------} product = foldl (\a b -> a * b) 1; {--------------------------------------------------------} sums = scanl (\a b -> a + b) 0; {--------------------------------------------------------} products = scanl (\a b -> a * b) 1; {--------------------------------------------------------} maximum = foldl1 max; {--------------------------------------------------------} minimum = foldl1 min; {--------------------------------------------------------} concat = foldr append Nil; {--------------------------------------------------------} transpose = foldr (\xs xss -> zipWith Cons xs (append xss (repeat Nil))) Nil; {--------------------------------------------------------} zip = zipWith (\a b -> Pair a b); {--------------------------------------------------------} { zip3 = zipWith3 (\a b c -> Tp3 a b c); } {--------------------------------------------------------} { zip4 = zipWith4 (\a b c d -> Tp4 a b c d); } {--------------------------------------------------------} zipWith z al bl = case al of Cons a as -> case bl of Cons b bs -> Cons (z a b) (zipWith z as bs); Nil -> Nil end; Nil -> Nil end; {--------------------------------------------------------} { zipWith3 z al bl cl = case al of Cons a as -> case bl of Cons b bs -> case cl of Cons c cs -> Cons (z a b c) (zipWith3 z as bs cs); Nil -> Nil end; Nil -> Nil end; Nil -> Nil end; } {--------------------------------------------------------} { zipWith4 z al bl cl dl = case al of Cons a as -> case bl of Cons b bs -> case cl of Cons c cs -> case dl of Cons d ds -> Cons (z a b c d) (zipWith4 z as bs cs ds); Nil -> Nil end; Nil -> Nil end; Nil -> Nil end; Nil -> Nil end; } {--------------------------------------------------------} {--------------------------------------------------------} {--------------------------------------------------------} {--------------------------------------------------------} {----------------------------------------------------------------} {--- end preludeList.cor ---} {----------------------------------------------------------------}