home *** CD-ROM | disk | FTP | other *** search
- ------------------------------------------------------------------------------
- --The files in this directory are based on the programs described in:
- --
- -- A Modular fully-lazy lambda lifter in Haskell
- -- Simon L. Peyton Jones and David Lester
- -- Software -- Practice and Experience
- -- Vol 21(5), pp.479-506
- -- MAY 1991
- --
- --See the Readme file for more details.
- ------------------------------------------------------------------------------
-
- -- Utilities:
- -- The following general purpose function is defined in the above paper:
- mapAccuml :: (b -> a -> (b,c)) -> b -> [a] -> (b,[c])
- mapAccuml f b [] = (b,[])
- mapAccuml f b (a:as) = (b'',c:cs) where (b',c) = f b a
- (b'',cs) = mapAccuml f b' as
-
- -- All subsequent definitions are my own implementations of functions
- -- specified only by type signatures and informal descriptions in the
- -- paper -- so blame me for any errors or misinterpretations!
-
- -- Sets: sets are implemented as ordered lists with no repetitions, as
- -- suggested by the use of (Ord) in the given signatures.
- -- Just for a change, we'll write these definitions out as
- -- iterations...
-
- data Set a = Set [a]
-
- setDifference :: Ord a => Set a -> Set a -> Set a
- setDifference (Set xs) (Set ys) = Set (differ xs ys)
- where differ (x:xs) (y:ys)
- | x==y = differ xs ys
- | x<y = x : differ xs (y:ys)
- | y<x = differ (x:xs) ys
- differ xs _ = xs
-
- setIntersect :: Ord a => Set a -> Set a -> Set a
- setIntersect (Set xs) (Set ys) = Set (intersect xs ys)
- where intersect (x:xs) (y:ys)
- | x==y = x : intersect xs ys
- | x<y = intersect xs (y:ys)
- | y<x = intersect (x:xs) ys
- intersect _ _ = []
-
- setUnion :: Ord a => Set a -> Set a -> Set a
- setUnion (Set xs) (Set ys) = Set (union xs ys)
- where union (x:xs) (y:ys)
- | x==y = x : union xs ys
- | x<y = x : union xs (y:ys)
- | y<x = y : union (x:xs) ys
- union xs ys = xs ++ ys
-
- setUnionList :: Ord a => [Set a] -> Set a
- setUnionList = foldr setUnion setEmpty
-
- setToList :: Set a -> [a]
- setToList (Set xs) = xs
-
- setFromList :: Ord a => [a] -> Set a
- setFromList = Set . sort . nub
-
- setSingleton :: a -> Set a
- setSingleton a = Set [a]
-
- setEmpty :: Set a
- setEmpty = Set []
-
- -- Bags: the given interface doesn't impose any constraint on the types
- -- that can be held in bags, so it doesn't seem that there is much
- -- to do other than make a bag type out of lists... for the benefits
- -- of type checking, I'll make a separate Bag data type constructor,
- -- although a synonym would have been acceptable...
-
- data Bag a = Bag [a]
-
- bagUnion :: Bag a -> Bag a -> Bag a
- bagUnion (Bag xs) (Bag ys) = Bag (xs++ys)
-
- bagInsert :: a -> Bag a -> Bag a
- bagInsert x (Bag xs) = Bag (x:xs)
-
- bagToList :: Bag a -> [a]
- bagToList (Bag bag) = bag
-
- bagFromList :: [a] -> Bag a
- bagFromList = Bag
-
- bagSingleton :: a -> Bag a
- bagSingleton x = Bag [x]
-
- bagEmpty :: Bag a
- bagEmpty = Bag []
-
- -- Association lists:
-
- type Assn a b = [(a,b)]
-
- assLookup :: Eq a => Assn a b -> a -> b
- assLookup ps a = head [ b | (a',b) <- ps, a==a' ]
-
- -- Name supply:
-
- type NameSupply = Int
-
- initialNameSupply :: NameSupply
- initialNameSupply = 0
-
- newName :: NameSupply -> String -> (NameSupply,String)
- newName ns prefix = (ns+1, prefix ++ show ns)
-
- -- That's it!!!
-