ghc/compiler/basicTypes/OrdList.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1994
   3 %
   4
   5 %
   6 % This is useful, general stuff for the Native Code Generator.
   7 %
   8
   9 \begin{code}
  10
  11 module OrdList (
  12         OrdList,
  13
  14         mkParList, mkSeqList, mkEmptyList, mkUnitList,
  15
  16         flattenOrdList
  17 -- UNUSED:
  18 --      concatOrdList, fnOrdList, foldOrdList,
  19 --      mapAccumBOrdList, mapAccumLOrdList, mapAccumROrdList,
  20 --      mapOrdList, reverseOrdList, simplOrdList
  21     ) where
  22
  23 import Util     ( mapAccumB, mapAccumL, mapAccumR )
  24
  25 \end{code}
  26
  27 This section provides an ordering list that allows fine grain
  28 parallelism to be expressed.  This is used (ultimately) for scheduling
  29 of assembly language instructions.
  30
  31 \begin{code}
  32
  33 data OrdList a = SeqList (OrdList a) (OrdList a)
  34                | ParList (OrdList a) (OrdList a)
  35                | OrdObj a
  36                | NoObj
  37                deriving ()
  38
  39 mkSeqList a b = SeqList a b
  40 mkParList a b = ParList a b
  41 mkEmptyList   = NoObj
  42 mkUnitList    = OrdObj
  43
  44 \end{code}
  45
  46 %------------------------------------------------------------------------
  47
  48 This simplifies an ordering list, using correctness preserving transformations.
  49 Notice the duality between @Seq@ and @Par@.
  50
  51 \begin{code}
  52 {- UNUSED:
  53 simplOrdList :: OrdList a -> OrdList a
  54 simplOrdList (SeqList vs)  =
  55       case (concat [
  56               (case simplOrdList v of
  57                  SeqList xs     -> xs
  58                  OrdObj a       -> [OrdObj a]
  59                  NoObj          -> []
  60                  xs             -> [xs]) | v <- vs]) of
  61         []  -> NoObj
  62         [x] -> x
  63         v   -> SeqList v
  64 simplOrdList (ParList vs)  =
  65       case (concat [
  66               (case simplOrdList v of
  67                  ParList xs     -> xs
  68                  OrdObj a       -> [OrdObj a]
  69                  NoObj          -> []
  70                  xs             -> [xs]) | v <- vs]) of
  71         []  -> NoObj
  72         [x] -> x
  73         v   -> ParList v
  74 simplOrdList v = v
  75 -}
  76 \end{code}
  77
  78 %------------------------------------------------------------------------
  79
  80 First the foldr !
  81
  82 \begin{code}
  83 {- UNUSED:
  84
  85 foldOrdList
  86       :: ([b] -> b)
  87       -> ([b] -> b)
  88       -> (a -> b)
  89       -> b
  90       -> (b -> b -> b)
  91       -> OrdList a
  92       -> b
  93 foldOrdList s p o n c (SeqList vs)   = s (map (foldOrdList s p o n c) vs)
  94 foldOrdList s p o n c (ParList vs)   = p (map (foldOrdList s p o n c) vs)
  95 foldOrdList s p o n c (OrdObj a)     = o a
  96 foldOrdList s p o n c  NoObj         = n
  97
  98 fnOrdList :: (a -> OrdList b) -> OrdList a -> OrdList b
  99 fnOrdList f (SeqList vs)   = SeqList (map (fnOrdList f) vs)
 100 fnOrdList f (ParList vs)   = ParList (map (fnOrdList f) vs)
 101 fnOrdList f (OrdObj a)     = f a
 102 fnOrdList f  NoObj         = NoObj
 103 -}
 104 \end{code}
 105
 106 This does a concat on an ordering list of ordering lists.
 107
 108 \begin{code}
 109 {- UNUSED:
 110 concatOrdList :: OrdList (OrdList a) -> OrdList a
 111 concatOrdList = fnOrdList id
 112 -}
 113 \end{code}
 114
 115 This performs a map over an ordering list.
 116
 117 \begin{code}
 118 {- UNUSED:
 119 mapOrdList :: (a -> b) -> OrdList a -> OrdList b
 120 mapOrdList f = fnOrdList (OrdObj.f)
 121 -}
 122 \end{code}
 123
 124 Here is the reverse over the OrdList.
 125
 126 \begin{code}
 127 {- UNUSED:
 128 reverseOrdList :: OrdList a -> OrdList a
 129 reverseOrdList NoObj        = NoObj
 130 reverseOrdList (OrdObj a)   = OrdObj a
 131 reverseOrdList (ParList vs) = ParList (reverse (map reverseOrdList vs))
 132 reverseOrdList (SeqList vs) = SeqList (reverse (map reverseOrdList vs))
 133 -}
 134 \end{code}
 135
 136 Notice this this throws away all potential expression of parrallism.
 137
 138 \begin{code}
 139 flattenOrdList :: OrdList a -> [a]
 140
 141 flattenOrdList ol
 142   = -- trace (shows ol "\n") (
 143     flat ol []
 144     -- )
 145   where
 146     flat :: OrdList a -> [a] -> [a]
 147     flat NoObj         rest = rest
 148     flat (OrdObj x)    rest = x:rest
 149     flat (ParList a b) rest = flat a (flat b rest)
 150     flat (SeqList a b) rest = flat a (flat b rest)
 151
 152 {- DEBUGGING ONLY:
 153 instance Text (OrdList a) where
 154     showsPrec _ NoObj   = showString "_N_"
 155     showsPrec _ (OrdObj _) = showString "_O_"
 156     showsPrec _ (ParList a b) = showString "(PAR " . shows a . showChar ')'
 157     showsPrec _ (SeqList a b) = showString "(SEQ " . shows a . showChar ')'
 158 -}
 159 \end{code}
 160
 161 This is like mapAccumR, but over OrdList's.
 162
 163 \begin{code}
 164 {- UNUSED:
 165 mapAccumROrdList :: (s -> a -> (s,b)) -> s -> OrdList a -> (s,OrdList b)
 166 mapAccumROrdList f s NoObj        = (s,NoObj)
 167 mapAccumROrdList f s (OrdObj a)   =
 168    case f s a of
 169       (s',b) -> (s',OrdObj b)
 170 mapAccumROrdList f s (SeqList vs) =
 171    case mapAccumR (mapAccumROrdList f) s vs of
 172       (s',b) -> (s',SeqList b)
 173 mapAccumROrdList f s (ParList vs) =
 174    case mapAccumR (mapAccumROrdList f) s vs of
 175       (s',b) -> (s',ParList b)
 176
 177 mapAccumLOrdList :: (s -> a -> (s,b)) -> s -> OrdList a -> (s,OrdList b)
 178 mapAccumLOrdList f s NoObj        = (s,NoObj)
 179 mapAccumLOrdList f s (OrdObj a)   =
 180    case f s a of
 181       (s',b) -> (s',OrdObj b)
 182 mapAccumLOrdList f s (SeqList vs) =
 183    case mapAccumL (mapAccumLOrdList f) s vs of
 184       (s',b) -> (s',SeqList b)
 185 mapAccumLOrdList f s (ParList vs) =
 186    case mapAccumL (mapAccumLOrdList f) s vs of
 187       (s',b) -> (s',ParList b)
 188
 189 mapAccumBOrdList :: (accl -> accr -> x -> (accl, accr, y))
 190           -> accl -> accr -> OrdList x -> (accl, accr, OrdList y)
 191
 192 mapAccumBOrdList f a b NoObj  = (a,b,NoObj)
 193 mapAccumBOrdList f a b (OrdObj x) =
 194    case f a b x of
 195       (a',b',y) -> (a',b',OrdObj y)
 196 mapAccumBOrdList f a b (SeqList xs) =
 197    case mapAccumB (mapAccumBOrdList f) a b xs of
 198       (a',b',ys) -> (a',b',SeqList ys)
 199 mapAccumBOrdList f a b (ParList xs) =
 200    case mapAccumB (mapAccumBOrdList f) a b xs of
 201       (a',b',ys) -> (a',b',ParList ys)
 202 -}
 203 \end{code}
 204
 205 %------------------------------------------------------------------------
 206
 207 In our printing schema, we use @||@ for parallel operations,
 208 and @;@ for sequential ones.
 209
 210 \begin{code}
 211
 212 #ifdef _GOFER_
 213
 214 instance (Text a) => Text (OrdList a) where
 215       showsPrec _ (ParList [a]) = shows a
 216       showsPrec _ (ParList as ) = showString "( " .
 217                                       showOurList as " || " .
 218                                   showString " )"
 219       showsPrec _ (SeqList [a]) = shows a
 220       showsPrec _ (SeqList as ) = showString "( " .
 221                                       showOurList as " ; " .
 222                                   showString " )"
 223       showsPrec _ (OrdObj a)    = shows a
 224       showsPrec _ (NoObj)       = showString "$"
 225
 226 showOurList :: (Text a) => [a] -> String -> ShowS
 227 showOurList []     s = showString ""
 228 showOurList [a]    s = shows a
 229 showOurList (a:as) s = shows a .
 230                        showString s .
 231                        showOurList as s
 232
 233 #endif
 234
 235 \end{code}
 236