[project @ 2004-08-13 13:04:50 by simonmar]

[ghc-hetmet.git] / ghc / compiler / utils / OrdList.lhs

diff --git a/ghc/compiler/utils/OrdList.lhs b/ghc/compiler/utils/OrdList.lhs
index ab683cd..7f22b38 100644 (file)
--- a/ghc/compiler/utils/OrdList.lhs
+++ b/ghc/compiler/utils/OrdList.lhs
@@ -1,57 +1,83 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 
 This is useful, general stuff for the Native Code Generator.
 
+Provide trees (of instructions), so that lists of instructions
+can be appended in linear time.
+
 \begin{code}
 module OrdList (
-       OrdList,
+       OrdList, 
+        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL,
+        fromOL, toOL, foldrOL, foldlOL
+) where
 
-       mkParList, mkSeqList, mkEmptyList, mkUnitList,
+infixl 5  `appOL`
+infixl 5  `snocOL`
+infixr 5  `consOL`
 
-       flattenOrdList
-    ) where
-\end{code}
+data OrdList a
+  = Many [a]
+  | Two (OrdList a) (OrdList a)
+  | One  a
+  | None
 
-This section provides an ordering list that allows fine grain
-parallelism to be expressed.  This is used (ultimately) for scheduling
-of assembly language instructions.
+nilOL    :: OrdList a
+isNilOL  :: OrdList a -> Bool
 
-\begin{code}
-data OrdList a
-  = SeqList (OrdList a) (OrdList a)
-  | ParList (OrdList a) (OrdList a)
-  | OrdObj a
-  | NoObj
-  deriving ()
-
-mkSeqList a b = SeqList a b
-mkParList a b = ParList a b
-mkEmptyList   = NoObj
-mkUnitList    = OrdObj
-\end{code}
+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
+snocOL as b  = Two as (One b)
+consOL a  bs = Two (One a) bs
+concatOL aas = foldr Two None aas
 
-Notice this this throws away all potential expression of parallelism.
+isNilOL None        = True
+isNilOL (One _)     = False
+isNilOL (Two as bs) = isNilOL as && isNilOL bs
+isNilOL (Many xs)   = null xs
 
-\begin{code}
-flattenOrdList :: OrdList a -> [a]
-
-flattenOrdList ol
-  = flat ol []
-  where
-    flat NoObj         rest = rest
-    flat (OrdObj x)    rest = x:rest
-    flat (ParList a b) rest = flat a (flat b rest)
-    flat (SeqList a b) rest = flat a (flat b rest)
-
-{- DEBUGGING ONLY:
-instance Text (OrdList a) where
-    showsPrec _ NoObj  = showString "_N_"
-    showsPrec _ (OrdObj _) = showString "_O_"
-    showsPrec _ (ParList a b) = showString "(PAR " . shows a . showChar ')'
-    showsPrec _ (SeqList a b) = showString "(SEQ " . shows a . showChar ')'
--}
+appOL None bs   = bs
+appOL as   None = as
+appOL as   bs   = Two as bs
+
+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
+
+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
+
+fromOL :: OrdList a -> [a]
+fromOL ol 
+   = flat ol []
+     where
+        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
+
+toOL :: [a] -> OrdList a
+toOL xs = Many xs
 \end{code}