summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2014-07-23 01:20:10 +1000
committerJed Barber <jjbarber@y7mail.com>2014-07-23 01:20:10 +1000
commit5f8fd03bcbe4d98aac3e247a2d39ec275a6fd451 (patch)
treeb2902686650c9ba33d8e9e7c1ef9ecfe7ecd0c33
parentbf08dbac7e988e6b282b19060cfba3c8b82e3684 (diff)
mod instruction added
-rw-r--r--src/Grasp/Interpreter.hs27
1 files changed, 26 insertions, 1 deletions
diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs
index 4e9914b..6662c0f 100644
--- a/src/Grasp/Interpreter.hs
+++ b/src/Grasp/Interpreter.hs
@@ -276,7 +276,32 @@ subdivI f g ip = do
modI :: GraspProgram -> IP -> IO (GraspProgram, IP)
-modI g ip = return (g,ip)
+modI g ip = do
+ let node = fst . head $ ip
+ edges = Graph.out g node
+
+ leftL = targetLabels g (getByLabel "left" edges)
+ rightL = targetLabels g (getByLabel "right" edges)
+ outN = targetNodes (getByLabel "out" edges)
+ nextLN = targetLNodes g (getByLabel "next" edges)
+
+ g' <- case (leftL, rightL) of
+ (x,y) | length x /= 1 || length y /= 1 ->
+ error ("Instruction " ++ (show node) ++ " requires " ++
+ "a single left edge and a single right edge")
+
+ (x,y) | not (all isFloat x && all isFloat y) ->
+ error ("Instruction " ++ (show node) ++
+ " has non numeric arguments")
+
+ (x,y) -> let s = (read . head $ x) `mod` (read . head $ y)
+ in return (foldl' (\gr n -> reLabel gr n (show s)) g outN)
+
+ ip' <- updateIP ip nextLN
+
+ return (g',ip')
+
+
getcI :: GraspProgram -> IP -> IO (GraspProgram, IP)
getcI g ip = return (g,ip)