OrdList.lhs 1.98 KB
Newer Older
1
%
2
% (c) The AQUA Project, Glasgow University, 1993-1998
3 4 5 6
%

This is useful, general stuff for the Native Code Generator.

7 8 9
Provide trees (of instructions), so that lists of instructions
can be appended in linear time.

10 11
\begin{code}
module OrdList (
12 13
	OrdList, 
        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL,
14
        fromOL, toOL, foldrOL, foldlOL
15
) where
16

17 18 19
infixl 5  `appOL`
infixl 5  `snocOL`
infixr 5  `consOL`
20 21

data OrdList a
22 23
  = Many [a]
  | Two (OrdList a) (OrdList a)
24 25 26 27 28 29 30 31 32 33 34 35 36 37
  | One  a
  | None

nilOL    :: OrdList a
isNilOL  :: OrdList a -> Bool

unitOL   :: a           -> OrdList a
snocOL   :: OrdList a   -> a         -> OrdList a
consOL   :: a           -> OrdList a -> OrdList a
appOL    :: OrdList a   -> OrdList a -> OrdList a
concatOL :: [OrdList a] -> OrdList a

nilOL        = None
unitOL as    = One as
38 39 40
snocOL as b  = Two as (One b)
consOL a  bs = Two (One a) bs
concatOL aas = foldr Two None aas
41

42 43 44 45
isNilOL None        = True
isNilOL (One _)     = False
isNilOL (Two as bs) = isNilOL as && isNilOL bs
isNilOL (Many xs)   = null xs
46 47 48

appOL None bs   = bs
appOL as   None = as
49 50
appOL as   bs   = Two as bs

51 52 53 54 55 56 57 58 59
mapOL :: (a -> b) -> OrdList a -> OrdList b
mapOL f None = None
mapOL f (One x) = One (f x)
mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)
mapOL f (Many xs) = Many (map f xs)

instance Functor OrdList where
  fmap = mapOL

60 61 62 63 64 65 66 67 68 69 70
foldrOL :: (a->b->b) -> b -> OrdList a -> b
foldrOL k z None        = z
foldrOL k z (One x)     = k x z
foldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1
foldrOL k z (Many xs)   = foldr k z xs

foldlOL :: (b->a->b) -> b -> OrdList a -> b
foldlOL k z None        = z
foldlOL k z (One x)     = k z x
foldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2
foldlOL k z (Many xs)   = foldl k z xs
71 72 73 74 75

fromOL :: OrdList a -> [a]
fromOL ol 
   = flat ol []
     where
76 77 78 79
        flat None      rest = rest
        flat (One x)   rest = x:rest
        flat (Two a b) rest = flat a (flat b rest)
	flat (Many xs) rest = xs ++ rest
80 81

toOL :: [a] -> OrdList a
82
toOL xs = Many xs
83
\end{code}