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 {-# OPTIONS -w #-}
  13 -- The above warning supression flag is a temporary kludge.
  14 -- While working on this module you are encouraged to remove it and fix
  15 -- any warnings in the module. See
  16 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  17 -- for details
  18
  19 module OrdList (
  20         OrdList,
  21         nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL,
  22         fromOL, toOL, foldrOL, foldlOL
  23 ) where
  24
  25 infixl 5  `appOL`
  26 infixl 5  `snocOL`
  27 infixr 5  `consOL`
  28
  29 data OrdList a
  30   = Many [a]        -- Invariant: non-empty
  31   | Two (OrdList a) -- Invariant: non-empty
  32         (OrdList a) -- Invariant: non-empty
  33   | One  a
  34   | None
  35
  36 nilOL    :: OrdList a
  37 isNilOL  :: OrdList a -> Bool
  38
  39 unitOL   :: a           -> OrdList a
  40 snocOL   :: OrdList a   -> a         -> OrdList a
  41 consOL   :: a           -> OrdList a -> OrdList a
  42 appOL    :: OrdList a   -> OrdList a -> OrdList a
  43 concatOL :: [OrdList a] -> OrdList a
  44
  45 nilOL        = None
  46 unitOL as    = One as
  47 snocOL None b    = One b
  48 snocOL as   b    = Two as (One b)
  49 consOL a    None = One a
  50 consOL a    bs   = Two (One a) bs
  51 concatOL aas = foldr appOL None aas
  52
  53 isNilOL None = True
  54 isNilOL _    = False
  55
  56 appOL None bs   = bs
  57 appOL as   None = as
  58 appOL as   bs   = Two as bs
  59
  60 mapOL :: (a -> b) -> OrdList a -> OrdList b
  61 mapOL f None = None
  62 mapOL f (One x) = One (f x)
  63 mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)
  64 mapOL f (Many xs) = Many (map f xs)
  65
  66 instance Functor OrdList where
  67   fmap = mapOL
  68
  69 foldrOL :: (a->b->b) -> b -> OrdList a -> b
  70 foldrOL k z None        = z
  71 foldrOL k z (One x)     = k x z
  72 foldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1
  73 foldrOL k z (Many xs)   = foldr k z xs
  74
  75 foldlOL :: (b->a->b) -> b -> OrdList a -> b
  76 foldlOL k z None        = z
  77 foldlOL k z (One x)     = k z x
  78 foldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2
  79 foldlOL k z (Many xs)   = foldl k z xs
  80
  81 fromOL :: OrdList a -> [a]
  82 fromOL ol
  83    = flat ol []
  84      where
  85         flat None      rest = rest
  86         flat (One x)   rest = x:rest
  87         flat (Two a b) rest = flat a (flat b rest)
  88         flat (Many xs) rest = xs ++ rest
  89
  90 toOL :: [a] -> OrdList a
  91 toOL [] = None
  92 toOL xs = Many xs
  93 \end{code}