compiler/utils/OrdList.lhs

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