From 60befe389b3a38f99ef560b74659bddd57bddd1c Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sat, 6 Dec 2014 20:48:46 +1100
Subject: Added garbage collection

---
 src/Grasp/Monad.hs    | 36 +++++++++++++++++++++++++++++++++++-
 src/Grasp/Types/IP.hs |  7 ++++++-
 2 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index d8ffff8..9780741 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -33,6 +33,7 @@ import Control.Monad.IO.Class( liftIO )
 
 import qualified Data.Maybe as Maybe
 
+import Data.List( (\\) )
 import qualified Data.List as List
 
 import Data.Map( Map )
@@ -192,6 +193,11 @@ nodesWithName ns es name =
 
 
 
+namedNodes :: [GNode] -> [GEdge] -> [GNode]
+namedNodes ns es = map fst (nameNodeList ns es)
+
+
+
 updateIP :: GraspM ()
 updateIP = do
     program <- State.get
@@ -238,12 +244,40 @@ nextIP :: GraspM ()
 nextIP = do
     program <- State.get
     let ips = instPtrs program
+        gr = programGraph program
         ips' = if (length ips == 0)
                 then []
                 else if (IP.isEmpty (head ips))
                         then tail ips
                         else (tail ips) ++ [head ips]
-    State.put (GraspProgram (programGraph program) ips' (fileHandles program))
+        gr' = garbageCollect gr ips'
+    State.put (GraspProgram gr' ips' (fileHandles program))
+
+
+
+garbageCollect :: Gr Instruction EdgeLabel -> [IP] -> Gr Instruction EdgeLabel
+garbageCollect gr ips =
+    let unreachable = (Graph.nodes gr) \\ (reachable gr ips)
+    in Graph.delNodes unreachable gr
+
+
+
+reachable :: Gr Instruction EdgeLabel -> [IP] -> [Node]
+reachable gr ips =
+    let named = namedNodes (map GN.mk (Graph.labNodes gr)) (map GE.mk (Graph.labEdges gr))
+        ipNodes = concatMap IP.toList ips
+        start = (map GN.toNode) . List.nub $ named ++ ipNodes
+    in reach gr start []
+
+
+
+reach :: Gr Instruction EdgeLabel -> [Node] -> [Node] -> [Node]
+reach _ [] f = f
+reach gr (x:xs) f =
+    let f' = List.nub (x:f)
+        x' = List.nub (xs ++ (Graph.suc gr x))
+        gr' = Graph.delNode x gr
+    in reach gr' x' f'
 
 
 
diff --git a/src/Grasp/Types/IP.hs b/src/Grasp/Types/IP.hs
index c7d3e4b..a548cc3 100644
--- a/src/Grasp/Types/IP.hs
+++ b/src/Grasp/Types/IP.hs
@@ -7,7 +7,9 @@ module Grasp.Types.IP (
     peek,
     push,
     pop,
-    shift
+    shift,
+
+    toList
 	) where
 
 
@@ -45,3 +47,6 @@ pop (IP p) = if (length p == 0) then empty else IP (tail p)
 shift :: GNode -> IP -> IP
 shift n (IP p) = if (length p == 0) then empty else IP (n:(tail p))
 
+toList :: IP -> [GNode]
+toList (IP p) = p
+
-- 
cgit