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         mapOL, 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]        -- Invariant: non-empty
  24   | Two (OrdList a) -- Invariant: non-empty
  25         (OrdList a) -- Invariant: non-empty
  26   | One  a
  27   | None
  28
  29 nilOL    :: OrdList a
  30 isNilOL  :: OrdList a -> Bool
  31
  32 unitOL   :: a           -> OrdList a
  33 snocOL   :: OrdList a   -> a         -> OrdList a
  34 consOL   :: a           -> OrdList a -> OrdList a
  35 appOL    :: OrdList a   -> OrdList a -> OrdList a
  36 concatOL :: [OrdList a] -> OrdList a
  37
  38 nilOL        = None
  39 unitOL as    = One as
  40 snocOL None b    = One b
  41 snocOL as   b    = Two as (One b)
  42 consOL a    None = One a
  43 consOL a    bs   = Two (One a) bs
  44 concatOL aas = foldr appOL None aas
  45
  46 isNilOL None = True
  47 isNilOL _    = False
  48
  49 appOL None bs   = bs
  50 appOL as   None = as
  51 appOL as   bs   = Two as bs
  52
  53 mapOL :: (a -> b) -> OrdList a -> OrdList b
  54 mapOL _ None = None
  55 mapOL f (One x) = One (f x)
  56 mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)
  57 mapOL f (Many xs) = Many (map f xs)
  58
  59 instance Functor OrdList where
  60   fmap = mapOL
  61
  62 foldrOL :: (a->b->b) -> b -> OrdList a -> b
  63 foldrOL _ z None        = z
  64 foldrOL k z (One x)     = k x z
  65 foldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1
  66 foldrOL k z (Many xs)   = foldr k z xs
  67
  68 foldlOL :: (b->a->b) -> b -> OrdList a -> b
  69 foldlOL _ z None        = z
  70 foldlOL k z (One x)     = k z x
  71 foldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2
  72 foldlOL k z (Many xs)   = foldl k z xs
  73
  74 fromOL :: OrdList a -> [a]
  75 fromOL ol
  76    = flat ol []
  77      where
  78         flat None      rest = rest
  79         flat (One x)   rest = x:rest
  80         flat (Two a b) rest = flat a (flat b rest)
  81         flat (Many xs) rest = xs ++ rest
  82
  83 toOL :: [a] -> OrdList a
  84 toOL [] = None
  85 toOL xs = Many xs
  86 \end{code}