FIX BUILD with GHC 6.2.x: VectInfo -> HscTypes.VectInfo
[ghc-hetmet.git] / 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}