pull out and expose fold function over blocks
authorNorman Ramsey <nr@cs.tufts.edu>
Fri, 23 Apr 2010 20:35:41 +0000 (16:35 -0400)
committerNorman Ramsey <nr@cs.tufts.edu>
Fri, 23 Apr 2010 20:35:41 +0000 (16:35 -0400)
src/Compiler/Hoopl/XUtil.hs

index 06a82c6..fcc83b6 100644 (file)
@@ -4,7 +4,7 @@
 
 module Compiler.Hoopl.XUtil
   ( firstXfer, distributeXfer, distributeFact
-  , foldNodes
+  , foldGraphNodes, foldBlockNodes
   )
 where
 
@@ -33,30 +33,41 @@ distributeXfer xfer n f = mkFactBase [ (l, xfer n f) | l <- successors n ]
 distributeFact :: Edges n => n O C -> f -> FactBase f
 distributeFact n f = mkFactBase [ (l, f) | l <- successors n ]
 
+-- | Fold a function over every node in a block.
+-- The fold function must be polymorphic in the shape of the nodes.
+foldBlockNodes :: forall n a .
+                  (forall e x . n e x       -> a -> a)
+               -> (forall e x . Block n e x -> a -> a)
 -- | Fold a function over every node in a graph.
 -- The fold function must be polymorphic in the shape of the nodes.
-foldNodes :: forall n a .
-             (forall e x . n e x       -> a -> a)
-          -> (forall e x . Graph n e x -> a -> a)
-foldNodes f = graph
+
+foldGraphNodes :: forall n a .
+                  (forall e x . n e x       -> a -> a)
+                -> (forall e x . Graph n e x -> a -> a)
+
+foldBlockNodes f = block
+  where block :: forall e x . Block n e x -> a -> a
+        block (BFirst  node)    = f node
+        block (BMiddle node)    = f node
+        block (BLast   node)    = f node
+        block (b1 `BCat`    b2) = block b1 . block b2
+        block (b1 `BClosed` b2) = block b1 . block b2
+        block (b1 `BHead` n)    = block b1 . f n
+        block (n `BTail` b2)    = f n . block b2
+
+foldGraphNodes f = graph
     where graph :: forall e x . Graph n e x -> a -> a
-          block :: forall e x . Block n e x -> a -> a
           lift  :: forall thing ex . (thing -> a -> a) -> (MaybeO ex thing -> a -> a)
 
           graph GNil              = id
           graph (GUnit b)         = block b
           graph (GMany e b x)     = lift block e . body b . lift block x
-          block (BFirst  node)    = f node
-          block (BMiddle node)    = f node
-          block (BLast   node)    = f node
-          block (b1 `BCat`    b2) = block b1 . block b2
-          block (b1 `BClosed` b2) = block b1 . block b2
-          block (b1 `BHead` n)    = block b1 . f n
-          block (n `BTail` b2)    = f n . block b2
           body (BodyEmpty)        = id
           body (BodyUnit b)       = block b
           body (b1 `BodyCat` b2)  = body b1 . body b2
           lift _ NothingO         = id
           lift f (JustO thing)    = f thing
 
+          block = foldBlockNodes f
+