Added utility functions for concatenating graphs and nodes.
authorNorman Ramsey <nr@cs.tufts.edu>
Thu, 22 Apr 2010 02:23:58 +0000 (22:23 -0400)
committerNorman Ramsey <nr@cs.tufts.edu>
Thu, 22 Apr 2010 02:23:58 +0000 (22:23 -0400)
src/Compiler/Hoopl/Util.hs

index faa4956..7ab8aca 100644 (file)
@@ -2,6 +2,8 @@
 
 module Compiler.Hoopl.Util
   ( gUnitOO, gUnitOC, gUnitCO, gUnitCC
+  , catGraphNodeOC, catGraphNodeOO
+  , catNodeCOGraph, catNodeOOGraph
   , graphMapBlocks
   , zblockGraph
   , postorder_dfs, postorder_dfs_from, postorder_dfs_from_except
@@ -29,6 +31,34 @@ gUnitOC b = GMany (JustO b) BodyEmpty   NothingO
 gUnitCO b = GMany NothingO  BodyEmpty   (JustO b)
 gUnitCC b = GMany NothingO  (BodyUnit b) NothingO
 
+
+catGraphNodeOC :: Graph n e O -> n O C -> Graph n e C
+catGraphNodeOO :: Graph n e O -> n O O -> Graph n e O
+catNodeCOGraph :: n C O -> Graph n O x -> Graph n C x
+catNodeOOGraph :: n O O -> Graph n O x -> Graph n O x
+
+catGraphNodeOO GNil                     n = gUnitOO $ BUnit n
+catGraphNodeOO (GUnit b)                n = gUnitOO $ b `BCat` BUnit n
+catGraphNodeOO (GMany e body (JustO x)) n = GMany e body (JustO $ x `BCat` BUnit n)
+
+catGraphNodeOC GNil                     n = gUnitOC $ BUnit n
+catGraphNodeOC (GUnit b)                n = gUnitOC $ b `BCat` BUnit n
+catGraphNodeOC (GMany e body (JustO x)) n = GMany e body' NothingO
+  where body' = body `BodyCat` BodyUnit (x `BCat` BUnit n)
+
+catNodeOOGraph n GNil                     = gUnitOO $ BUnit n
+catNodeOOGraph n (GUnit b)                = gUnitOO $ BUnit n `BCat` b
+catNodeOOGraph n (GMany (JustO e) body x) = GMany (JustO $ BUnit n `BCat` e) body x
+
+catNodeCOGraph n GNil                     = gUnitCO $ BUnit n
+catNodeCOGraph n (GUnit b)                = gUnitCO $ BUnit n `BCat` b
+catNodeCOGraph n (GMany (JustO e) body x) = GMany NothingO body' x
+  where body' = BodyUnit (BUnit n `BCat` e) `BodyCat` body
+
+
+
+
+
 zblockGraph :: ZBlock n e x -> ZGraph n e x
 zblockGraph b@(ZFirst  {}) = gUnitCO b
 zblockGraph b@(ZMiddle {}) = gUnitOO b