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
+
+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}