summaryrefslogtreecommitdiff
path: root/src/Grasp
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2014-08-30 22:58:24 +1000
committerJed Barber <jjbarber@y7mail.com>2014-08-30 22:58:24 +1000
commit6927f94b2d7e709a4941b9566b282d808cd05b31 (patch)
tree8429015c1b0f6d8259f5da0ac22c2d5c112795bb /src/Grasp
parent85cb6b7f7537a1d33c2efaada6ef6844c148219f (diff)
Partial pop/pick instructions coded
Diffstat (limited to 'src/Grasp')
-rw-r--r--src/Grasp/Interpreter.hs40
1 files changed, 36 insertions, 4 deletions
diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs
index 67632bc..7223416 100644
--- a/src/Grasp/Interpreter.hs
+++ b/src/Grasp/Interpreter.hs
@@ -213,7 +213,7 @@ pushI g node = do
let label = if (inL == []) then "" else inL !! rnd
if (length stackN /= 1)
- then error ("Instruction " ++ (show node) ++ " should only have one stack argument")
+ then error ("Instruction " ++ (show node) ++ " should have one stack argument")
else doPushI g (head stackN) label
@@ -226,7 +226,7 @@ implicitPushI g node =
label = fromJust $ Graph.lab g node
in if (length stackN /= 1)
- then error ("Instruction " ++ (show node) ++ " should only have one stack argument")
+ then error ("Instruction " ++ (show node) ++ " should have one stack argument")
else doPushI g (head stackN) label
@@ -249,10 +249,42 @@ doPushI g s l =
popI :: GraspProgram -> Node -> IO GraspProgram
-popI g node = return g
+popI g node =
+ let edges = Graph.out g node
+
+ stackN = targetNodes (getByLabel "stack" edges)
+ outL = targetLabels g (getByLabel "out" edges)
+ emptyL = targetLabels g (getByLabel "empty" edges)
+
+ in return g
+
+
pickI :: GraspProgram -> Node -> IO GraspProgram
-pickI g node = return g
+pickI g node =
+ let edges = Graph.out g node
+
+ stackN = targetNodes (getByLabel "stack" edges)
+ depthL = targetLabels g (getByLabel "depth" edges)
+ outL = targetLabels g (getByLabel "out" edges)
+ emptyL = targetLabels g (getByLabel "empty" edges)
+
+ in case (stackN, depthL) of
+ (x,_) | length x /= 1 -> error ("Instruction " ++ (show node) ++
+ " should have one stack argument")
+
+ (_,y) | length y /= 1 -> error ("Instruction " ++ (show node) ++
+ " should have one depth argument")
+
+ (_,y) | not (isFloat (head y)) -> error ("Instruction " ++ (show node) ++
+ " should have numeric depth argument")
+
+ (x,y) -> doPickI g (head x) (head y) outL emptyL
+
+
+
+doPickI :: GraspProgram -> Node -> String -> [String] -> [String] -> IO GraspProgram
+doPickI g s d out empty = return g