From 249f880de5050387b748eae184ec3019ebab2afc Mon Sep 17 00:00:00 2001
From: Norman Ramsey <nr@cs.tufts.edu>
Date: Wed, 21 Apr 2010 22:23:58 -0400
Subject: [PATCH] Added utility functions for concatenating graphs and nodes.

---
 src/Compiler/Hoopl/Util.hs | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

diff --git a/src/Compiler/Hoopl/Util.hs b/src/Compiler/Hoopl/Util.hs
index faa4956..7ab8aca 100644
--- a/src/Compiler/Hoopl/Util.hs
+++ b/src/Compiler/Hoopl/Util.hs
@@ -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
-- 
1.9.1