Add blockMapNodes and blockMapNodes3.
authorMilan Straka <fox@ucw.cz>
Sun, 16 May 2010 22:24:31 +0000 (23:24 +0100)
committerMilan Straka <fox@ucw.cz>
Sun, 16 May 2010 22:24:31 +0000 (23:24 +0100)
src/Compiler/Hoopl/Util.hs

index cc9d119..7b31c33 100644 (file)
@@ -5,6 +5,7 @@ module Compiler.Hoopl.Util
   , catGraphNodeOC, catGraphNodeOO
   , catNodeCOGraph, catNodeOOGraph
   , graphMapBlocks
+  , blockMapNodes, blockMapNodes3
   , blockGraph
   , postorder_dfs, postorder_dfs_from, postorder_dfs_from_except
   , preorder_dfs, preorder_dfs_from_except
@@ -94,6 +95,22 @@ graphMapBlocks f = map
 
 bodyMapBlocks f (Body body) = Body $ mapMap f body
 
+-- | Function 'blockMapNodes' enables a change of nodes in a block.
+blockMapNodes3 :: ( n C O -> n C O
+                  , n O O -> n O O
+                  , n O C -> n O C)
+               -> Block n e x -> Block n e x
+blockMapNodes3 (f, _, _) (BFirst n)     = BFirst (f n)
+blockMapNodes3 (_, m, _) (BMiddle n)    = BMiddle (m n)
+blockMapNodes3 (_, _, l) (BLast n)      = BLast (l n)
+blockMapNodes3 fs (BCat x y)            = BCat (blockMapNodes3 fs x) (blockMapNodes3 fs y)
+blockMapNodes3 fs@(_, m, _) (BHead x n) = BHead (blockMapNodes3 fs x) (m n)
+blockMapNodes3 fs@(_, m, _) (BTail n x) = BTail (m n) (blockMapNodes3 fs x)
+blockMapNodes3 fs (BClosed x y)         = BClosed (blockMapNodes3 fs x) (blockMapNodes3 fs y)
+
+blockMapNodes :: (forall e x. n e x -> n e x)
+              -> Block n e x -> Block n e x
+blockMapNodes f = blockMapNodes3 (f, f, f)
 
 ----------------------------------------------------------------