X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FOrdList.lhs;h=d093e43c7597b425357d69826be22c2f41553fc5;hb=0877011afd5886ee06df2e2723d631ff0686324f;hp=223ff88422760f833ac22aaab4317952d7219b6b;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/OrdList.lhs b/ghc/compiler/utils/OrdList.lhs
index 223ff88..d093e43 100644
--- a/ghc/compiler/utils/OrdList.lhs
+++ b/ghc/compiler/utils/OrdList.lhs
@@ -1,59 +1,74 @@
 %
-% (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
+data OrdList a
+  = Many [a]
+  | Two (OrdList a) (OrdList a)
+  | One  a
+  | None
 
-import Util	( mapAccumB, mapAccumL, mapAccumR )
-\end{code}
+nilOL    :: OrdList a
+isNilOL  :: OrdList a -> Bool
 
-This section provides an ordering list that allows fine grain
-parallelism to be expressed.  This is used (ultimately) for scheduling
-of assembly language instructions.
+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
 
-\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}
+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
 
-%------------------------------------------------------------------------
+isNilOL None        = True
+isNilOL (One _)     = False
+isNilOL (Two as bs) = isNilOL as && isNilOL bs
+isNilOL (Many xs)   = null xs
 
-Notice this this throws away all potential expression of parallelism.
+appOL None bs   = bs
+appOL as   None = as
+appOL as   bs   = Two as bs
 
-\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 ')'
--}
+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}