compiler/utils/OrdList.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The AQUA Project, Glasgow University, 1993-1998
   4 %
   5
   6 This is useful, general stuff for the Native Code Generator.
   7
   8 Provide trees (of instructions), so that lists of instructions
   9 can be appended in linear time.
  10
  11 \begin{code}
  12 module OrdList (
  13         OrdList,
  14         nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL,
  15         fromOL, toOL, foldrOL, foldlOL
  16 ) where
  17
  18 infixl 5  `appOL`
  19 infixl 5  `snocOL`
  20 infixr 5  `consOL`
  21
  22 data OrdList a
  23   = Many [a]
  24   | Two (OrdList a) (OrdList a)
  25   | One  a
  26   | None
  27
  28 nilOL    :: OrdList a
  29 isNilOL  :: OrdList a -> Bool
  30
  31 unitOL   :: a           -> OrdList a
  32 snocOL   :: OrdList a   -> a         -> OrdList a
  33 consOL   :: a           -> OrdList a -> OrdList a
  34 appOL    :: OrdList a   -> OrdList a -> OrdList a
  35 concatOL :: [OrdList a] -> OrdList a
  36
  37 nilOL        = None
  38 unitOL as    = One as
  39 snocOL as b  = Two as (One b)
  40 consOL a  bs = Two (One a) bs
  41 concatOL aas = foldr Two None aas
  42
  43 isNilOL None        = True
  44 isNilOL (One _)     = False
  45 isNilOL (Two as bs) = isNilOL as && isNilOL bs
  46 isNilOL (Many xs)   = null xs
  47
  48 appOL None bs   = bs
  49 appOL as   None = as
  50 appOL as   bs   = Two as bs
  51
  52 mapOL :: (a -> b) -> OrdList a -> OrdList b
  53 mapOL f None = None
  54 mapOL f (One x) = One (f x)
  55 mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)
  56 mapOL f (Many xs) = Many (map f xs)
  57
  58 instance Functor OrdList where
  59   fmap = mapOL
  60
  61 foldrOL :: (a->b->b) -> b -> OrdList a -> b
  62 foldrOL k z None        = z
  63 foldrOL k z (One x)     = k x z
  64 foldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1
  65 foldrOL k z (Many xs)   = foldr k z xs
  66
  67 foldlOL :: (b->a->b) -> b -> OrdList a -> b
  68 foldlOL k z None        = z
  69 foldlOL k z (One x)     = k z x
  70 foldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2
  71 foldlOL k z (Many xs)   = foldl k z xs
  72
  73 fromOL :: OrdList a -> [a]
  74 fromOL ol
  75    = flat ol []
  76      where
  77         flat None      rest = rest
  78         flat (One x)   rest = x:rest
  79         flat (Two a b) rest = flat a (flat b rest)
  80         flat (Many xs) rest = xs ++ rest
  81
  82 toOL :: [a] -> OrdList a
  83 toOL xs = Many xs
  84 \end{code}