diff options
author | Jed Barber <jjbarber@y7mail.com> | 2014-08-30 17:50:50 +1000 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2014-08-30 17:50:50 +1000 |
commit | edcb54083308a86a9a73bf9930a41891986fa830 (patch) | |
tree | b08ced7c7103be12140f9b9626856071f5767692 | |
parent | 79fbf24fd6ab9965eb8374a06f01daf304788abe (diff) |
Added push instruction
-rw-r--r-- | src/Grasp/Interpreter.hs | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs index 03a2978..5781f73 100644 --- a/src/Grasp/Interpreter.hs +++ b/src/Grasp/Interpreter.hs @@ -198,12 +198,36 @@ delI g node = (headN == [] || y `elem` headN) && (labelL == [] || z `elem` labelL)) (Graph.labEdges g) - in return (foldl' (\gr e -> Graph.delLEdge e gr) g edgesToDel) + in return (foldl' (flip Graph.delLEdge) g edgesToDel) pushI :: GraspProgram -> Node -> IO GraspProgram -pushI g node = return g +pushI g node = + let edges = Graph.out g node + + stackN = targetNodes (getByLabel "stack" edges) + inL = targetLabels g (getByLabel "in" edges) + + in if (length stackN /= 1) then error ("Instruction " ++ (show node) ++ + " should only have one stack argument") + else do + let newN = head (Graph.newNodes 1 g) + labelN <- if (inL == []) then return "" + else (getStdRandom (randomR (0,length inL - 1))) >>= (\x -> return (inL !! x)) + + let edgesToDel = Graph.inn g (head stackN) + edgesToAdd = map (\(x,y,z) -> (x,newN,z)) edgesToDel + + nextE = (newN,(head stackN),"next") + + g' = Graph.insNode (newN,labelN) g + g'' = foldl' (flip Graph.delLEdge) g' edgesToDel + g''' = Graph.insEdges (nextE:edgesToAdd) g'' + + return g''' + + popI :: GraspProgram -> Node -> IO GraspProgram popI g node = return g |