home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / Modular / Utility < prev   
Text File  |  1994-06-23  |  4KB  |  114 lines
  1. ------------------------------------------------------------------------------
  2. --The files in this directory are based on the programs described in:
  3. --
  4. --    A Modular fully-lazy lambda lifter in Haskell
  5. --    Simon L. Peyton Jones and David Lester
  6. --    Software -- Practice and Experience
  7. --    Vol 21(5), pp.479-506
  8. --    MAY 1991
  9. --
  10. --See the Readme file for more details.
  11. ------------------------------------------------------------------------------
  12.  
  13. -- Utilities:
  14. -- The following general purpose function is defined in the above paper:
  15. mapAccuml           :: (b -> a -> (b,c)) -> b -> [a] -> (b,[c])
  16. mapAccuml f b []     = (b,[])
  17. mapAccuml f b (a:as) = (b'',c:cs)  where (b',c) = f b a
  18.                                          (b'',cs) = mapAccuml f b' as
  19.  
  20. -- All subsequent definitions are my own implementations of functions
  21. -- specified only by type signatures and informal descriptions in the
  22. -- paper -- so blame me for any errors or misinterpretations!
  23.  
  24. -- Sets: sets are implemented as ordered lists with no repetitions, as
  25. --       suggested by the use of (Ord) in the given signatures.
  26. --       Just for a change, we'll write these definitions out as
  27. --       iterations...
  28.  
  29. data Set a = Set [a]
  30.  
  31. setDifference                  :: Ord a => Set a -> Set a -> Set a
  32. setDifference (Set xs) (Set ys) = Set (differ xs ys)
  33.  where differ (x:xs) (y:ys)
  34.                          | x==y = differ xs ys
  35.                          | x<y  = x : differ xs (y:ys)
  36.                          | y<x  = differ (x:xs) ys
  37.        differ xs     _          = xs
  38.  
  39. setIntersect                  :: Ord a => Set a -> Set a -> Set a
  40. setIntersect (Set xs) (Set ys) = Set (intersect xs ys)
  41.  where intersect (x:xs) (y:ys)
  42.                         | x==y = x : intersect xs ys
  43.                         | x<y  = intersect xs (y:ys)
  44.                         | y<x  = intersect (x:xs) ys
  45.        intersect _      _      = []
  46.  
  47. setUnion                      :: Ord a => Set a -> Set a -> Set a
  48. setUnion (Set xs) (Set ys)     = Set (union xs ys)
  49.  where union (x:xs) (y:ys)
  50.                         | x==y = x : union xs ys
  51.                         | x<y  = x : union xs (y:ys)
  52.                         | y<x  = y : union (x:xs) ys
  53.        union xs     ys         = xs ++ ys
  54.  
  55. setUnionList                  :: Ord a => [Set a] -> Set a
  56. setUnionList                   = foldr setUnion setEmpty
  57.  
  58. setToList                     :: Set a -> [a]
  59. setToList (Set xs)             = xs
  60.  
  61. setFromList                   :: Ord a => [a] -> Set a
  62. setFromList                    = Set . sort . nub
  63.  
  64. setSingleton                  :: a -> Set a
  65. setSingleton a                 = Set [a]
  66.  
  67. setEmpty                      :: Set a
  68. setEmpty                       = Set []
  69.  
  70. -- Bags: the given interface doesn't impose any constraint on the types
  71. --       that can be held in bags, so it doesn't seem that there is much
  72. --       to do other than make a bag type out of lists... for the benefits
  73. --       of type checking, I'll make a separate Bag data type constructor,
  74. --       although a synonym would have been acceptable...
  75.  
  76. data Bag a    = Bag [a]
  77.  
  78. bagUnion                  :: Bag a -> Bag a -> Bag a
  79. bagUnion (Bag xs) (Bag ys) = Bag (xs++ys)
  80.  
  81. bagInsert                 :: a -> Bag a -> Bag a
  82. bagInsert x (Bag xs)       = Bag (x:xs)
  83.  
  84. bagToList                 :: Bag a -> [a]
  85. bagToList (Bag bag)        = bag
  86.  
  87. bagFromList               :: [a] -> Bag a
  88. bagFromList                = Bag
  89.  
  90. bagSingleton              :: a -> Bag a
  91. bagSingleton x             = Bag [x]
  92.  
  93. bagEmpty                  :: Bag a
  94. bagEmpty                   = Bag []
  95.  
  96. -- Association lists:
  97.  
  98. type Assn a b = [(a,b)]
  99.  
  100. assLookup      :: Eq a => Assn a b -> a -> b
  101. assLookup ps a  = head [ b | (a',b) <- ps, a==a' ]
  102.  
  103. -- Name supply:
  104.  
  105. type NameSupply = Int
  106.  
  107. initialNameSupply :: NameSupply
  108. initialNameSupply  = 0
  109.  
  110. newName           :: NameSupply -> String -> (NameSupply,String)
  111. newName ns prefix  = (ns+1, prefix ++ show ns)
  112.  
  113. -- That's it!!!
  114.