Rename BTail -> BCons, BHead -> BSnoc
authorSimon Marlow <marlowsd@gmail.com>
Fri, 6 Jul 2012 10:21:18 +0000 (11:21 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 6 Jul 2012 15:04:31 +0000 (16:04 +0100)
src/Compiler/Hoopl/Block.hs
src/Compiler/Hoopl/Dataflow.hs
src/Compiler/Hoopl/DataflowFold.hs
src/Compiler/Hoopl/Graph.hs
src/Compiler/Hoopl/OldDataflow.hs
src/Compiler/Hoopl/Show.hs

index 9916b2e..920ba73 100644 (file)
@@ -103,8 +103,8 @@ data Block n e x where
   BNil    :: Block n O O
   BMiddle :: n O O                      -> Block n O O
   BCat    :: Block n O O -> Block n O O -> Block n O O
-  BHead   :: Block n O O -> n O O       -> Block n O O
-  BTail   :: n O O       -> Block n O O -> Block n O O
+  BSnoc   :: Block n O O -> n O O       -> Block n O O
+  BCons   :: n O O       -> Block n O O -> Block n O O
 
 
 -- -----------------------------------------------------------------------------
@@ -125,21 +125,21 @@ emptyBlock = BNil
 
 blockCons :: n O O -> Block n O x -> Block n O x
 blockCons n b = case b of
-  BlockOC b l  -> BlockOC (n `BTail` b) l
-  BNil{}    -> n `BTail` b
-  BMiddle{} -> n `BTail` b
-  BCat{}    -> n `BTail` b
-  BHead{}   -> n `BTail` b
-  BTail{}   -> n `BTail` b
+  BlockOC b l  -> BlockOC (n `BCons` b) l
+  BNil{}    -> n `BCons` b
+  BMiddle{} -> n `BCons` b
+  BCat{}    -> n `BCons` b
+  BSnoc{}   -> n `BCons` b
+  BCons{}   -> n `BCons` b
 
 blockSnoc :: Block n e O -> n O O -> Block n e O
 blockSnoc b n = case b of
-  BlockCO f b -> BlockCO f (b `BHead` n)
-  BNil{}      -> b `BHead` n
-  BMiddle{}   -> b `BHead` n
-  BCat{}      -> b `BHead` n
-  BHead{}     -> b `BHead` n
-  BTail{}     -> b `BHead` n
+  BlockCO f b -> BlockCO f (b `BSnoc` n)
+  BNil{}      -> b `BSnoc` n
+  BMiddle{}   -> b `BSnoc` n
+  BCat{}      -> b `BSnoc` n
+  BSnoc{}     -> b `BSnoc` n
+  BCons{}     -> b `BSnoc` n
 
 blockJoinHead :: n C O -> Block n O x -> Block n C x
 blockJoinHead f (BlockOC b l) = BlockCC f b l
@@ -191,8 +191,8 @@ blockSplitAny block = case block of
   b@BNil        -> (NothingC, b, NothingC)
   b@BMiddle{}   -> (NothingC, b, NothingC)
   b@BCat{}      -> (NothingC, b, NothingC)
-  b@BTail{}     -> (NothingC, b, NothingC)
-  b@BHead{}     -> (NothingC, b, NothingC)
+  b@BCons{}     -> (NothingC, b, NothingC)
+  b@BSnoc{}     -> (NothingC, b, NothingC)
 
 blockToList :: Block n O O -> [n O O]
 blockToList b = go b []
@@ -200,11 +200,11 @@ blockToList b = go b []
          go BNil         r = r
          go (BMiddle n)  r = n : r
          go (BCat b1 b2) r = go b1 $! go b2 r
-         go (BHead b1 n) r = go b1 (n:r)
-         go (BTail n b1) r = n : go b1 r
+         go (BSnoc b1 n) r = go b1 (n:r)
+         go (BCons n b1) r = n : go b1 r
 
 blockFromList :: [n O O] -> Block n O O
-blockFromList = foldr BTail BNil
+blockFromList = foldr BCons BNil
 
 
 -- | Convert a list of nodes to a block. The entry and exit node must
@@ -240,41 +240,41 @@ cat x y = case x of
                    BNil         -> x
                    BMiddle _    -> BlockCO l $! (b1 `cat` y)
                    BCat{}       -> BlockCO l $! (b1 `cat` y)
-                   BHead{}      -> BlockCO l $! (b1 `cat` y)
-                   BTail{}      -> BlockCO l $! (b1 `cat` y)
+                   BSnoc{}      -> BlockCO l $! (b1 `cat` y)
+                   BCons{}      -> BlockCO l $! (b1 `cat` y)
 
   BMiddle n -> case y of
                    BlockOC b2 n2 -> (BlockOC $! (x `cat` b2)) n2
                    BNil          -> x
-                   BMiddle{}     -> BTail n y
-                   BCat{}        -> BTail n y
-                   BHead{}       -> BTail n y
-                   BTail{}       -> BTail n y
+                   BMiddle{}     -> BCons n y
+                   BCat{}        -> BCons n y
+                   BSnoc{}       -> BCons n y
+                   BCons{}       -> BCons n y
 
   BCat{} -> case y of
                    BlockOC b3 n2 -> (BlockOC $! (x `cat` b3)) n2
                    BNil          -> x
-                   BMiddle n     -> BHead x n
+                   BMiddle n     -> BSnoc x n
                    BCat{}        -> BCat x y
-                   BHead{}       -> BCat x y
-                   BTail{}       -> BCat x y
+                   BSnoc{}       -> BCat x y
+                   BCons{}       -> BCat x y
 
-  BHead{} -> case y of
+  BSnoc{} -> case y of
                    BlockOC b2 n2 -> (BlockOC $! (x `cat` b2)) n2
                    BNil          -> x
-                   BMiddle n     -> BHead x n
+                   BMiddle n     -> BSnoc x n
                    BCat{}        -> BCat x y
-                   BHead{}       -> BCat x y
-                   BTail{}       -> BCat x y
+                   BSnoc{}       -> BCat x y
+                   BCons{}       -> BCat x y
 
 
-  BTail{} -> case y of
+  BCons{} -> case y of
                    BlockOC b2 n2 -> (BlockOC $! (x `cat` b2)) n2
                    BNil          -> x
-                   BMiddle n     -> BHead x n
+                   BMiddle n     -> BSnoc x n
                    BCat{}        -> BCat x y
-                   BHead{}       -> BCat x y
-                   BTail{}       -> BCat x y
+                   BSnoc{}       -> BCat x y
+                   BCons{}       -> BCat x y
 
 
 -- -----------------------------------------------------------------------------
@@ -288,8 +288,8 @@ mapBlock f (BlockCC n b m) = BlockCC (f n) (mapBlock f b) (f m)
 mapBlock _  BNil           = BNil
 mapBlock f (BMiddle n)     = BMiddle (f n)
 mapBlock f (BCat b1 b2)    = BCat    (mapBlock f b1) (mapBlock f b2)
-mapBlock f (BHead b n)     = BHead   (mapBlock f b)  (f n)
-mapBlock f (BTail n b)     = BTail   (f n)  (mapBlock f b)
+mapBlock f (BSnoc b n)     = BSnoc   (mapBlock f b)  (f n)
+mapBlock f (BCons n b)     = BCons   (f n)  (mapBlock f b)
 
 -- | A strict 'mapBlock'
 mapBlock' :: (forall e x. n e x -> n' e x) -> (Block n e x -> Block n' e x)
@@ -311,8 +311,8 @@ mapBlock3' (f, m, l) b = go b
         go BNil            = BNil
         go (BMiddle n)     = BMiddle $! m n
         go (BCat x y)      = (BCat $! go x) $! (go y)
-        go (BHead x n)     = (BHead $! go x) $! (m n)
-        go (BTail n x)     = (BTail $! m n) $! (go x)
+        go (BSnoc x n)     = (BSnoc $! go x) $! (m n)
+        go (BCons n x)     = (BCons $! m n) $! (go x)
 
 -- -----------------------------------------------------------------------------
 -- Folding
@@ -345,8 +345,8 @@ foldBlockNodesF3 (ff, fm, fl) = block
         block BNil              = id
         block (BMiddle node)    = fm node
         block (b1 `BCat`    b2) = block b1 `cat` block b2
-        block (b1 `BHead` n)    = block b1 `cat` fm n
-        block (n `BTail` b2)    = fm n `cat` block b2
+        block (b1 `BSnoc` n)    = block b1 `cat` fm n
+        block (n `BCons` b2)    = fm n `cat` block b2
         cat :: forall a b c. (a -> b) -> (b -> c) -> a -> c
         cat f f' = f' . f
 
@@ -360,8 +360,8 @@ foldBlockNodesB3 (ff, fm, fl) = block
         block BNil              = id
         block (BMiddle node)    = fm node
         block (b1 `BCat`    b2) = block b1 `cat` block b2
-        block (b1 `BHead` n)    = block b1 `cat` fm n
-        block (n `BTail` b2)    = fm n `cat` block b2
+        block (b1 `BSnoc` n)    = block b1 `cat` fm n
+        block (n `BCons` b2)    = fm n `cat` block b2
         cat :: forall a b c. (b -> c) -> (a -> b) -> a -> c
         cat f f' = f . f'
 
@@ -385,15 +385,15 @@ frontBiasBlock blk = case blk of
    b@BNil{}      -> fb b BNil
    b@BMiddle{}   -> fb b BNil
    b@BCat{}      -> fb b BNil
-   b@BHead{}     -> fb b BNil
-   b@BTail{}     -> fb b BNil
+   b@BSnoc{}     -> fb b BNil
+   b@BCons{}     -> fb b BNil
  where
    fb :: Block n O O -> Block n O O -> Block n O O
    fb BNil        rest = rest
-   fb (BMiddle n) rest = BTail n rest
+   fb (BMiddle n) rest = BCons n rest
    fb (BCat l r)  rest = fb l (fb r rest)
-   fb (BTail n b) rest = BTail n (fb b rest)
-   fb (BHead b n) rest = fb b (BTail n rest)
+   fb (BCons n b) rest = BCons n (fb b rest)
+   fb (BSnoc b n) rest = fb b (BCons n rest)
 
 -- | A block is "back biased" if the right child of every
 -- concatenation operation is a node, not a general block; a
@@ -410,12 +410,12 @@ backBiasBlock blk = case blk of
    b@BNil{}      -> bb BNil b
    b@BMiddle{}   -> bb BNil b
    b@BCat{}      -> bb BNil b
-   b@BHead{}     -> bb BNil b
-   b@BTail{}     -> bb BNil b
+   b@BSnoc{}     -> bb BNil b
+   b@BCons{}     -> bb BNil b
  where
    bb :: Block n O O -> Block n O O -> Block n O O
    bb rest BNil = rest
-   bb rest (BMiddle n) = BHead rest n
+   bb rest (BMiddle n) = BSnoc rest n
    bb rest (BCat l r) = bb (bb rest l) r
-   bb rest (BTail n b) = bb (BHead rest n) b
-   bb rest (BHead b n) = BHead (bb rest b) n
+   bb rest (BCons n b) = bb (BSnoc rest n) b
+   bb rest (BSnoc b n) = BSnoc (bb rest b) n
index 120c789..b01a2e3 100644 (file)
@@ -254,8 +254,8 @@ arfGraph pass@FwdPass { fp_lattice = lattice,
     block (BMiddle n)  = node n
     block (BCat b1 b2) = block b1 `cat` block b2
 -- @ end block.tex
-    block (BHead h n)  = block h  `cat` node n
-    block (BTail n t)  = node  n  `cat` block t
+    block (BSnoc h n)  = block h  `cat` node n
+    block (BCons n t)  = node  n  `cat` block t
 
 -- @ start node.tex -4
     node n f
@@ -444,8 +444,8 @@ arbGraph pass@BwdPass { bp_lattice  = lattice,
 
     block (BMiddle n)  = node n
     block (BCat b1 b2) = block b1 `cat` block b2
-    block (BHead h n)  = block h  `cat` node n
-    block (BTail n t)  = node  n  `cat` block t
+    block (BSnoc h n)  = block h  `cat` node n
+    block (BCons n t)  = node  n  `cat` block t
 
     node n f
       = do { bwdres <- brewrite rewrite n f
index 74cd8eb..562c34c 100644 (file)
@@ -229,8 +229,8 @@ arfGraph pass head entries g f = graph g (head, f)
    block (BMiddle n)  = node n
    block (BLast   n)  = node n
    block (BCat b1 b2) = block b1 `cat` block b2
-   block (BHead h n)  = block h  `cat` node n
-   block (BTail n t)  = node  n  `cat` block t
+   block (BSnoc h n)  = block h  `cat` node n
+   block (BCons n t)  = node  n  `cat` block t
    block (BClosed h t)= block h  `cat` block t
 
    node thenode (head, f)
@@ -353,8 +353,8 @@ arbBlock pass (BFirst  node)  = arbNode pass node
 arbBlock pass (BMiddle node)  = arbNode pass node
 arbBlock pass (BLast   node)  = arbNode pass node
 arbBlock pass (BCat b1 b2)    = arbCat arbBlock arbBlock pass b1 b2
-arbBlock pass (BHead h n)     = arbCat arbBlock arbNode  pass h n
-arbBlock pass (BTail n t)     = arbCat arbNode  arbBlock pass n t
+arbBlock pass (BSnoc h n)     = arbCat arbBlock arbNode  pass h n
+arbBlock pass (BCons n t)     = arbCat arbNode  arbBlock pass n t
 arbBlock pass (BClosed h t)   = arbCat arbBlock arbBlock pass h t
 
 arbCat :: NonLocal n => ARB' n f thing1 e O -> ARB' n f thing2 O x
@@ -632,8 +632,8 @@ rgunit f b@(BFirst  {}) = gUnitCO (FBlock f b)
 rgunit f b@(BMiddle {}) = gUnitOO (FBlock f b)
 rgunit f b@(BLast   {}) = gUnitOC (FBlock f b)
 rgunit f b@(BCat {})    = gUnitOO (FBlock f b)
-rgunit f b@(BHead {})   = gUnitCO (FBlock f b)
-rgunit f b@(BTail {})   = gUnitOC (FBlock f b)
+rgunit f b@(BSnoc {})   = gUnitCO (FBlock f b)
+rgunit f b@(BCons {})   = gUnitOC (FBlock f b)
 rgunit f b@(BClosed {}) = gUnitCC (FBlock f b)
 
 rgCat = U.splice fzCat
@@ -681,7 +681,7 @@ instance ShapeLifter O O where
   frewrite  (FwdPass {fp_rewrite  = FwdRewrites  (_, fr, _)}) n f = fr n f
   brewrite  (BwdPass {bp_rewrite  = BwdRewrites  (_, br, _)}) n f = br n f
   spliceRgNode (GMany e body (JustO (FBlock f x))) _ n = GMany e body (JustO x')
-     where x' = FBlock f $ BHead x n
+     where x' = FBlock f $ BSnoc x n
   spliceRgNode (GNil) f n = GUnit $ FBlock f $ BMiddle n
   spliceRgNode (GUnit (FBlock f b)) _ n = GUnit $ FBlock f $ b `BCat` BMiddle n
   entry _ = NothingC
index 76e5b73..cf56f7c 100644 (file)
@@ -131,9 +131,9 @@ catNodeOOGraph ::               n O O -> Graph n O x -> Graph n O x
 catNodeCOGraph :: NonLocal n => n C O -> Graph n O x -> Graph n C x
 
 catGraphNodeOO GNil                     n = gUnitOO $ BMiddle n
-catGraphNodeOO (GUnit b)                n = gUnitOO $ BHead b n
+catGraphNodeOO (GUnit b)                n = gUnitOO $ BSnoc b n
 catGraphNodeOO (GMany e body (JustO (BlockCO f b))) n
-  = GMany e body (JustO (BlockCO f (BHead b n)))
+  = GMany e body (JustO (BlockCO f (BSnoc b n)))
 
 catGraphNodeOC GNil                     n = gUnitOC $ BlockOC BNil n
 catGraphNodeOC (GUnit b)                n = gUnitOC $ BlockOC b n
@@ -141,9 +141,9 @@ catGraphNodeOC (GMany e body (JustO (BlockCO f x))) n
   = GMany e (addBlock (BlockCC f x n) body) NothingO
 
 catNodeOOGraph n GNil                     = gUnitOO $ BMiddle n
-catNodeOOGraph n (GUnit b)                = gUnitOO $ BTail n b
+catNodeOOGraph n (GUnit b)                = gUnitOO $ BCons n b
 catNodeOOGraph n (GMany (JustO (BlockOC b l)) body x)
-   = GMany (JustO (BlockOC (n `BTail` b) l)) body x
+   = GMany (JustO (BlockOC (n `BCons` b) l)) body x
 
 catNodeCOGraph f GNil                     = gUnitCO (BlockCO f BNil)
 catNodeCOGraph f (GUnit b)                = gUnitCO (BlockCO f b)
@@ -158,8 +158,8 @@ blockGraph b@(BlockCC {}) = gUnitCC b
 blockGraph   (BNil  {})   = GNil
 blockGraph b@(BMiddle {}) = gUnitOO b
 blockGraph b@(BCat {})    = gUnitOO b
-blockGraph b@(BHead {})   = gUnitOO b
-blockGraph b@(BTail {})   = gUnitOO b
+blockGraph b@(BSnoc {})   = gUnitOO b
+blockGraph b@(BCons {})   = gUnitOO b
 
 
 -- -----------------------------------------------------------------------------
index b258782..8664edd 100644 (file)
@@ -223,8 +223,8 @@ arfBlock pass (BFirst  node)  = arfNode pass node
 arfBlock pass (BMiddle node)  = arfNode pass node
 arfBlock pass (BLast   node)  = arfNode pass node
 arfBlock pass (BCat b1 b2)    = arfCat arfBlock arfBlock pass b1 b2
-arfBlock pass (BHead h n)     = arfCat arfBlock arfNode  pass h n
-arfBlock pass (BTail n t)     = arfCat arfNode  arfBlock pass n t
+arfBlock pass (BSnoc h n)     = arfCat arfBlock arfNode  pass h n
+arfBlock pass (BCons n t)     = arfCat arfNode  arfBlock pass n t
 arfBlock pass (BClosed h t)   = arfCat arfBlock arfBlock pass h t
 
 arfCat :: (pass -> thing1 -> info1 -> FuelMonad (RG f n e a, info2))
@@ -355,8 +355,8 @@ arbBlock pass (BFirst  node)  = arbNode pass node
 arbBlock pass (BMiddle node)  = arbNode pass node
 arbBlock pass (BLast   node)  = arbNode pass node
 arbBlock pass (BCat b1 b2)    = arbCat arbBlock arbBlock pass b1 b2
-arbBlock pass (BHead h n)     = arbCat arbBlock arbNode  pass h n
-arbBlock pass (BTail n t)     = arbCat arbNode  arbBlock pass n t
+arbBlock pass (BSnoc h n)     = arbCat arbBlock arbNode  pass h n
+arbBlock pass (BCons n t)     = arbCat arbNode  arbBlock pass n t
 arbBlock pass (BClosed h t)   = arbCat arbBlock arbBlock pass h t
 
 arbCat :: (pass -> thing1 -> info1 -> FuelMonad (RG f n e a, info1'))
@@ -636,8 +636,8 @@ rgunit f b@(BFirst  {}) = gUnitCO (FBlock f b)
 rgunit f b@(BMiddle {}) = gUnitOO (FBlock f b)
 rgunit f b@(BLast   {}) = gUnitOC (FBlock f b)
 rgunit f b@(BCat {})    = gUnitOO (FBlock f b)
-rgunit f b@(BHead {})   = gUnitCO (FBlock f b)
-rgunit f b@(BTail {})   = gUnitOC (FBlock f b)
+rgunit f b@(BSnoc {})   = gUnitCO (FBlock f b)
+rgunit f b@(BCons {})   = gUnitOC (FBlock f b)
 rgunit f b@(BClosed {}) = gUnitCC (FBlock f b)
 
 rgCat = U.splice fzCat
index a0cd46a..28e105c 100644 (file)
@@ -35,8 +35,8 @@ showGraph node = g
         b (BNil)          = ""
         b (BMiddle n)     = node n ++ "\n"
         b (BCat b1 b2)    = b b1   ++ b b2
-        b (BHead b1 n)    = b b1   ++ node n ++ "\n"
-        b (BTail n b1)    = node n ++ "\n" ++ b b1
+        b (BSnoc b1 n)    = b b1   ++ node n ++ "\n"
+        b (BCons n b1)    = node n ++ "\n" ++ b b1
 
 open :: (a -> String) -> MaybeO z a -> String
 open _ NothingO  = ""