call and ret instructions added

2 files changed, 111 insertions, 8 deletions

diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs
index bca167a..c9d807e 100644
--- a/src/Grasp/Interpreter.hs
+++ b/src/Grasp/Interpreter.hs
@@ -152,12 +152,50 @@ pickI = GMonad.updateIP
 
 
 callI :: GraspM ()
-callI = GMonad.updateIP
+callI = do
+    curNode <- GMonad.peekIP >>= return . Maybe.fromJust
+
+    funcNodes <- GMonad.nodesOut (EL.mk "func") curNode
+    argEdges <- GMonad.edgesOut curNode
+    ae <- return (filter (\x -> (GE.toLabel x) /= (EL.mk "name") && (GE.toLabel x) /= (EL.mk "cond") &&
+                                (GE.toLabel x) /= (EL.mk "next") && (GE.toLabel x) /= (EL.mk "func")) argEdges)
+    possibleFuncs <- mapM GMonad.nodesWithName (map GN.toInst funcNodes) >>= return . concat
+
+    Monad.when (length possibleFuncs < 1) (error "Instruction call has no applicable func candidates")
+
+    r <- liftIO (Random.getStdRandom (Random.randomR (0, length possibleFuncs - 1)))
+    (sn, se) <- GMonad.subGraph (possibleFuncs !! r)
+
+    sn' <- GMonad.newNodes (map GN.toInst sn)
+    let nodeMap = zip (map GN.toNode sn) (map GN.toNode sn')
+        translate = Maybe.fromJust . (flip lookup nodeMap)
+    se' <- return (map (\x -> GE.mk (translate . GE.toSrc $ x, translate . GE.toDest $ x, GE.toLabel x)) se)
+
+    let calledNode = GN.mk (translate (GN.toNode (possibleFuncs !! r)), GN.toInst (possibleFuncs !! r))
+    ae' <- return (map (\x -> GE.mk (GN.toNode calledNode, GE.toDest x, GE.toLabel x)) ae)
+
+    GMonad.insNodes sn'
+    GMonad.insEdges (se' ++ ae')
+
+    GMonad.pushIP calledNode
 
 
 
 retI :: GraspM ()
-retI = GMonad.updateIP
+retI = do
+    curNode <- GMonad.peekIP >>= return . Maybe.fromJust
+
+    retEdges <- GMonad.edgesOut curNode
+    re <- return (filter (\x -> (GE.toLabel x) /= (EL.mk "name") && (GE.toLabel x) /= (EL.mk "next") &&
+                                (GE.toLabel x) /= (EL.mk "cond")) retEdges)
+
+    GMonad.popIP
+    GMonad.updateIP
+    curNode' <- GMonad.peekIP
+
+    Monad.when (Maybe.isJust curNode') (do
+        re' <- return (map (\x -> GE.mk (GN.toNode . Maybe.fromJust $ curNode', GE.toDest x, GE.toLabel x)) re)
+        GMonad.insEdges re' )
 
 
 
diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index ba500af..86de9a2 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -15,6 +15,11 @@ module Grasp.Monad (
 
     nodesOut, edgesOut,
     reLabel,
+    nodesWithName,
+    subGraph,
+    newNodes,
+    insNode, insNodes,
+    delNode, delNodes,
     insEdge, insEdges,
     delEdge, delEdges
     ) where
@@ -81,7 +86,7 @@ construct (ns,es) = do
     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")
+        ips = map IP.singleton (getNodesWithName ns es "grasp:main")
         handles = Map.empty
 
     State.put (graph, ips, handles)
@@ -111,14 +116,14 @@ nameNodeList ns es =
 
 
 
-nodesWithName :: [GNode] -> [GEdge] -> String -> [GNode]
-nodesWithName ns es name =
+getNodesWithName :: [GNode] -> [GEdge] -> String -> [GNode]
+getNodesWithName 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)
+getNamedNodes :: [GNode] -> [GEdge] -> [GNode]
+getNamedNodes ns es = map fst (nameNodeList ns es)
 
 
 
@@ -176,7 +181,7 @@ garbageCollect gr ips =
 
 reachable :: Gr Instruction EdgeLabel -> [IP] -> [Node]
 reachable gr ips =
-    let named = namedNodes (map GN.mk (Graph.labNodes gr)) (map GE.mk (Graph.labEdges gr))
+    let named = getNamedNodes (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 []
@@ -338,6 +343,66 @@ reLabel i n = do
 
 
 
+nodesWithName :: Instruction -> GraspM [GNode]
+nodesWithName x = do
+    (gr, ips, fh) <- State.get
+    let ns = map GN.mk (Graph.labNodes gr)
+        es = map GE.mk (Graph.labEdges gr)
+    return (getNodesWithName ns es (IN.toString x))
+
+
+
+subGraph :: GNode -> GraspM ([GNode],[GEdge])
+subGraph n = do
+    (gr, ips, fh) <- State.get
+    let rNodes = reach gr [GN.toNode n] []
+        rEdges = filter (\(x,y,z) -> x `elem` rNodes && y `elem` rNodes) (Graph.labEdges gr)
+        result = (map (\x -> GN.mk (x, Maybe.fromJust (Graph.lab gr x))) rNodes, map GE.mk rEdges)
+    return result
+
+
+
+newNodes :: [Instruction] -> GraspM [GNode]
+newNodes is = do
+    (gr, ips, fh) <- State.get
+    let newNs = Graph.newNodes (length is) gr
+        newGNs = map GN.mk (zip newNs is)
+    return newGNs
+
+
+
+insNode :: GNode -> GraspM ()
+insNode n = do
+    (gr, ips, fh) <- State.get
+    let gr' = Graph.insNode (GN.toLNode n) gr
+    State.put (gr', ips, fh)
+
+
+
+insNodes :: [GNode] -> GraspM ()
+insNodes ns = do
+    (gr, ips, fh) <- State.get
+    let gr' = Graph.insNodes (map GN.toLNode ns) gr
+    State.put (gr', ips, fh)
+
+
+
+delNode :: GNode -> GraspM ()
+delNode n = do
+    (gr, ips, fh) <- State.get
+    let gr' = Graph.delNode (GN.toNode n) gr
+    State.put (gr', ips, fh)
+
+
+
+delNodes :: [GNode] -> GraspM ()
+delNodes ns = do
+    (gr, ips, fh) <- State.get
+    let gr' = Graph.delNodes (map GN.toNode ns) gr
+    State.put (gr', ips, fh)
+
+
+
 insEdge :: GEdge -> GraspM ()
 insEdge e = do
     (gr, ips, fh) <- State.get