From 3c6662a0b9a00df225037b10ddcd7fec4ce50568 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 6 Dec 2014 21:15:04 +1100 Subject: Organising code, removed superfluous GraspProgram data structure --- src/Grasp/Monad.hs | 196 +++++++++++++++++++++++++++++------------------------ 1 file 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 -- cgit