diff options
author | Jed Barber <jjbarber@y7mail.com> | 2014-08-30 22:58:24 +1000 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2014-08-30 22:58:24 +1000 |
commit | 6927f94b2d7e709a4941b9566b282d808cd05b31 (patch) | |
tree | 8429015c1b0f6d8259f5da0ac22c2d5c112795bb | |
parent | 85cb6b7f7537a1d33c2efaada6ef6844c148219f (diff) |
Partial pop/pick instructions coded
-rw-r--r-- | src/Grasp/Interpreter.hs | 40 |
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 |