author Simon Marlow Thu, 26 Jan 2012 16:01:49 +0000 (16:01 +0000) committer Simon Marlow Thu, 26 Jan 2012 16:01:49 +0000 (16:01 +0000)

index 2f06aba..ff5b59e 100644 (file)
@@ -11,6 +11,7 @@ module Compiler.Hoopl.XUtil

-- ** Simple operations on blocks
isEmptyBlock
+  , emptyBlock, blockCons, blockSnoc
, firstNode, lastNode, endNodes
@@ -57,12 +58,55 @@ import Compiler.Hoopl.Util
-- -----------------------------------------------------------------------------
-- Simple operations on Blocks

+
+-- Predicates
+
isEmptyBlock :: Block n e x -> Bool
isEmptyBlock BNil       = True
isEmptyBlock (BCat l r) = isEmptyBlock l && isEmptyBlock r
isEmptyBlock _          = False

+-- Building
+
+emptyBlock :: Block n O O
+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
+
+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
+  BTail{}     -> b `BHead` n
+
+blockJoinHead :: n C O -> Block n O x -> Block n C x
+blockJoinHead f (BlockOC b l) = BlockCC f b l
+blockJoinHead f b = BlockCO f BNil `cat` b
+
+blockJoinTail :: Block n e O -> n O C -> Block n e C
+blockJoinTail (BlockCO f b) t = BlockCC f b t
+blockJoinTail b t = b `cat` BlockOC BNil t
+
+blockJoin :: n C O -> Block n O O -> n O C -> Block n C C
+blockJoin f b t = BlockCC f b t
+
+blockAppend :: Block n e O -> Block n O x -> Block n e x
+blockAppend = cat
+
+
+-- Taking apart
+
firstNode :: Block n C x -> n C O
firstNode (BlockCO n _)   = n
firstNode (BlockCC n _ _) = n
@@ -74,7 +118,6 @@ lastNode (BlockCC _ _ n) = n
endNodes :: Block n C C -> (n C O, n O C)
endNodes (BlockCC f _ l) = (f,l)

-
blockSplitHead :: Block n C x -> (n C O, Block n O x)
blockSplitHead (BlockCO n b)   = (n, b)
blockSplitHead (BlockCC n b t) = (n, BlockOC b t)
@@ -86,19 +129,20 @@ blockSplitTail (BlockCC f b t) = (BlockCO f b, t)
blockSplit :: Block n C C -> (n C O, Block n O O, n O C)
blockSplit (BlockCC f b t) = (f, b, t)

-blockJoinHead :: n C O -> Block n O x -> Block n C x
-blockJoinHead f (BlockOC b l) = BlockCC f b l
-blockJoinHead f b = BlockCO f BNil `cat` b
+blockToList :: Block n O O -> [n O O]
+blockToList b = go b []
+   where go :: Block n O O -> [n O O] -> [n O O]
+         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

-blockJoinTail :: Block n e O -> n O C -> Block n e C
-blockJoinTail (BlockCO f b) t = BlockCC f b t
-blockJoinTail b t = b `cat` BlockOC BNil t
+blockFromList :: [n O O] -> Block n O O
+blockFromList = foldr BTail BNil

-blockJoin :: n C O -> Block n O O -> n O C -> Block n C C
-blockJoin f b t = BlockCC f b t

-blockAppend :: Block n e O -> Block n O x -> Block n e x
-blockAppend = cat
+-- Modifying

replaceFirstNode :: Block n C x -> n C O -> Block n C x
replaceFirstNode (BlockCO _ b)   f = BlockCO f b
@@ -109,18 +153,6 @@ replaceLastNode (BlockOC   b _) n = BlockOC b n
replaceLastNode (BlockCC l b _) n = BlockCC l b n

-blockToList :: Block n O O -> [n O O]
-blockToList b = go b []
-   where go :: Block n O O -> [n O O] -> [n O O]
-         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
-
-blockFromList :: [n O O] -> Block n O O
-blockFromList = foldr BTail BNil
-
-----------------------------------------------------------------------------

{-