Organising code, removed superfluous GraspProgram data structure

1 files changed, 106 insertions, 90 deletions

diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index 9780741..b49b53d 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -60,45 +60,70 @@ import qualified Grasp.Types.EdgeLabel as EL
 
 
 
-type GraspM a = StateT GraspProgram IO a
+type GraspM a = StateT (Gr Instruction EdgeLabel, [IP], Map FilePath Handle) IO a
 
 
 
 
-data GraspProgram = GraspProgram { programGraph :: Gr Instruction EdgeLabel
-                                 , instPtrs :: [IP]
-                                 , fileHandles :: Map FilePath Handle }
-    deriving (Show, Eq)
-
 
+-- wrapping and unwrapping
 
 
 construct :: ([GNode],[GEdge]) -> GraspM ()
-construct (n,e) = do
-    Monad.when (multiNodes n) (error "node declared multiple times")
-    Monad.when (unconnected n e) (error "unconnected edge")
-    Monad.when (multiNames n e) (error "node with multiple names")
-    Monad.when (numericName n e) (error "node with a numeric name")
-    Monad.when (noMain n e) (error "could not find grasp:main")
-
-    let graph = Graph.mkGraph (map GN.toLNode n) (map GE.toLEdge e)
-        ips = map IP.singleton (nodesWithName n e "grasp:main")
+construct (ns,es) = do
+    Monad.when (multiNodes ns) (error "node declared multiple times")
+    Monad.when (unconnected ns es) (error "unconnected edge")
+    Monad.when (multiNames ns es) (error "node with multiple names")
+    Monad.when (numericName ns es) (error "node with a numeric name")
+    Monad.when (noMain ns es) (error "could not find grasp:main")
+
+    let graph = Graph.mkGraph (map GN.toLNode ns) (map GE.toLEdge es)
+        ips = map IP.singleton (nodesWithName ns es "grasp:main")
         handles = Map.empty
 
-    State.put (GraspProgram graph ips handles)
+    State.put (graph, ips, handles)
 
 
 
 finalise :: GraspM () -> IO ([GNode],[GEdge])
 finalise s = do
-    p <- State.execStateT s (GraspProgram Graph.empty [] Map.empty)
-    (mapM_ IO.hClose) . Map.elems . fileHandles $ p
-    let gr = programGraph p
-        (nodes, edges) = (Graph.labNodes gr, Graph.labEdges gr)
+    (gr, ips, fh) <- State.execStateT s (Graph.empty, [], Map.empty)
+    (mapM_ IO.hClose) . Map.elems $ fh
+    let (nodes, edges) = (Graph.labNodes gr, Graph.labEdges gr)
     return (map GN.mk nodes, map GE.mk edges)
 
 
 
+
+
+-- internally used functions
+
+
+-- fix this later so it doesn't required unconnected edge checking first
+nameNodeList :: [GNode] -> [GEdge] -> [(GNode,GNode)]
+nameNodeList ns es =
+    let nameEdges = filter ((== (EL.mk "name")) . GE.toLabel) es
+        findNode n = Maybe.fromJust (List.find ((== n) . GN.toNode) ns)
+    in map (\x -> (findNode (GE.toSrc x), findNode (GE.toDest x))) nameEdges
+
+
+
+nodesWithName :: [GNode] -> [GEdge] -> String -> [GNode]
+nodesWithName ns es name =
+    (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (IN.mk name))) $ (nameNodeList ns es)
+
+
+
+namedNodes :: [GNode] -> [GEdge] -> [GNode]
+namedNodes ns es = map fst (nameNodeList ns es)
+
+
+
+
+
+-- error checking when setting up
+
+
 multiNodes :: [GNode] -> Bool
 multiNodes ns = (ns == (List.nubBy (\x y -> GN.toNode x == GN.toNode y) ns))
 
@@ -134,15 +159,50 @@ noMain ns es =
 
 
 
+
+
+-- garbage collection
+
+
+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'
+
+
+
+
+
+-- I/O
+
+
 getWriteHandle :: FilePath -> GraspM Handle
 getWriteHandle path = do
-    program <- State.get
-    let (gr, ptrs, handles) = ((programGraph program), (instPtrs program), (fileHandles program))
+    (gr, ips, fh) <- State.get
 
-    case (Map.lookup path handles) of
+    case (Map.lookup path fh) of
         Nothing -> do
             h <- liftIO (IO.openFile path IO.AppendMode)
-            State.put (GraspProgram gr ptrs (Map.insert path h handles))
+            State.put (gr, ips, (Map.insert path h fh))
             return h
 
         Just x -> do
@@ -150,7 +210,7 @@ getWriteHandle path = do
             if (not w) then do
                 liftIO (IO.hClose x)
                 h <- liftIO (IO.openFile path IO.AppendMode)
-                State.put (GraspProgram gr ptrs (Map.insert path h handles))
+                State.put (gr, ips, (Map.insert path h fh))
                 return h
             else return x
 
@@ -158,13 +218,12 @@ getWriteHandle path = do
 
 getReadHandle :: FilePath -> GraspM Handle
 getReadHandle path = do
-    program <- State.get
-    let (gr, ptrs, handles) = ((programGraph program), (instPtrs program), (fileHandles program))
+    (gr, ips, fh) <- State.get
 
-    case (Map.lookup path (fileHandles program)) of
+    case (Map.lookup path fh) of
         Nothing -> do
             h <- liftIO (IO.openFile path IO.ReadMode)
-            State.put (GraspProgram gr ptrs (Map.insert path h handles))
+            State.put (gr, ips, (Map.insert path h fh))
             return h
 
         Just x -> do
@@ -172,122 +231,79 @@ getReadHandle path = do
             if (not r) then do
                 liftIO (IO.hClose x)
                 h <- liftIO (IO.openFile path IO.ReadMode)
-                State.put (GraspProgram gr ptrs (Map.insert path h handles))
+                State.put (gr, ips, (Map.insert path h fh))
                 return h
             else return x
 
 
 
--- fix this later so it doesn't required unconnected edge checking first
-nameNodeList :: [GNode] -> [GEdge] -> [(GNode,GNode)]
-nameNodeList ns es =
-    let nameEdges = filter ((== (EL.mk "name")) . GE.toLabel) es
-        findNode n = Maybe.fromJust (List.find ((== n) . GN.toNode) ns)
-    in map (\x -> (findNode (GE.toSrc x), findNode (GE.toDest x))) nameEdges
-
-
-
-nodesWithName :: [GNode] -> [GEdge] -> String -> [GNode]
-nodesWithName ns es name =
-    (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (IN.mk name))) $ (nameNodeList ns es)
-
-
 
-namedNodes :: [GNode] -> [GEdge] -> [GNode]
-namedNodes ns es = map fst (nameNodeList ns es)
 
+-- manipulating the instruction pointers
 
 
 updateIP :: GraspM ()
 updateIP = do
-    program <- State.get
+    (gr, ips, fh) <- State.get
     curNode <- peekIP
     Monad.when (Maybe.isJust curNode) (do
         nexts <- nodesOut (EL.mk "next") (Maybe.fromJust curNode)
         r <- liftIO (Random.getStdRandom (Random.randomR (0, length nexts - 1)))
 
-        let ips = instPtrs program
-            updated = if (length nexts == 0) then IP.empty else IP.shift (nexts !! r) (head ips)
+        let updated = if (length nexts == 0) then IP.empty else IP.shift (nexts !! r) (head ips)
             ips' = updated:(tail ips)
 
-        State.put (GraspProgram (programGraph program) ips' (fileHandles program)) )
+        State.put (gr, ips', fh) )
 
 
 
 pushIP :: GNode -> GraspM ()
 pushIP n = do
-    program <- State.get
-    let ips = instPtrs program
-        ips' = if (length ips == 0) then [] else (IP.push n (head ips)):(tail ips)
-    State.put (GraspProgram (programGraph program) ips' (fileHandles program))
+    (gr, ips, fh) <- State.get
+    let ips' = if (length ips == 0) then [] else (IP.push n (head ips)):(tail ips)
+    State.put (gr, ips', fh)
 
 
 
 popIP :: GraspM ()
 popIP = do
-    program <- State.get
-    let ips = instPtrs program
-        ips' = if (length ips == 0) then [] else (IP.pop (head ips)):(tail ips)
-    State.put (GraspProgram (programGraph program) ips' (fileHandles program))
+    (gr, ips, fh) <- State.get
+    let ips' = if (length ips == 0) then [] else (IP.pop (head ips)):(tail ips)
+    State.put (gr, ips', fh)
 
 
 
 peekIP :: GraspM (Maybe GNode)
 peekIP = do
-    program <- State.get
-    let ips = instPtrs program
+    (gr, ips, fh) <- State.get
     if (length ips == 0) then return Nothing else return (IP.peek (head ips))
 
 
 
 nextIP :: GraspM ()
 nextIP = do
-    program <- State.get
-    let ips = instPtrs program
-        gr = programGraph program
-        ips' = if (length ips == 0)
+    (gr, ips, fh) <- State.get
+    let ips' = if (length ips == 0)
                 then []
                 else if (IP.isEmpty (head ips))
                         then tail ips
                         else (tail ips) ++ [head ips]
         gr' = garbageCollect gr ips'
-    State.put (GraspProgram gr' ips' (fileHandles program))
+    State.put (gr', ips', fh)
 
 
 
-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'
-
+-- accessing and manipulating the graph
 
 
 nodesOut :: EdgeLabel -> GNode -> GraspM [GNode]
 nodesOut s n = do
-    program <- State.get
+    (gr, ips, fh) <- State.get
     curNode <- peekIP
 
-    let gr = programGraph program
-        nout = Graph.lsuc gr (GN.toNode (Maybe.fromJust curNode))
+    let nout = Graph.lsuc gr (GN.toNode (Maybe.fromJust curNode))
         filtered = filter ((== s) . snd) nout
         result = map (\(x,y) -> GN.mk (x, Maybe.fromJust (Graph.lab gr x))) filtered