From 41d162f92468424e3b2df229e2e14a02105e7c73 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 7 Dec 2014 01:02:44 +1100 Subject: Arithmetic instructions added --- src/Grasp/Interpreter.hs | 88 +++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 83 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs index 40bc028..32ca41e 100644 --- a/src/Grasp/Interpreter.hs +++ b/src/Grasp/Interpreter.hs @@ -142,27 +142,105 @@ retI = GMonad.updateIP addI :: GraspM () -addI = GMonad.updateIP +addI = do + curNode <- GMonad.peekIP >>= return . Maybe.fromJust + + argNodes <- GMonad.nodesOut (EL.mk "arg") curNode + outNodes <- GMonad.nodesOut (EL.mk "out") curNode + + Monad.unless (all (Maybe.isJust . IN.toFloat . GN.toInst) argNodes) + (error "Instruction add should have numeric arg arguments") + + let input = map (Maybe.fromJust . IN.toFloat . GN.toInst) argNodes + result = sum input + mapM_ (GMonad.reLabel (IN.mk (show result))) outNodes + + GMonad.updateIP mulI :: GraspM () -mulI = GMonad.updateIP +mulI = do + curNode <- GMonad.peekIP >>= return . Maybe.fromJust + + argNodes <- GMonad.nodesOut (EL.mk "arg") curNode + outNodes <- GMonad.nodesOut (EL.mk "out") curNode + + Monad.unless (all (Maybe.isJust . IN.toFloat . GN.toInst) argNodes) + (error "Instruction mul should have numeric arg arguments") + + let input = map (Maybe.fromJust . IN.toFloat . GN.toInst) argNodes + result = product input + mapM_ (GMonad.reLabel (IN.mk (show result))) outNodes + + GMonad.updateIP subI :: GraspM () -subI = GMonad.updateIP +subI = do + curNode <- GMonad.peekIP >>= return . Maybe.fromJust + + leftNodes <- GMonad.nodesOut (EL.mk "left") curNode + rightNodes <- GMonad.nodesOut (EL.mk "right") curNode + outNodes <- GMonad.nodesOut (EL.mk "out") curNode + + Monad.when (length leftNodes /= 1) (error "Instruction sub should have one left argument") + Monad.unless (all (Maybe.isJust . IN.toFloat . GN.toInst) leftNodes) + (error "Instruction sub should have numeric left arguments") + Monad.unless (all (Maybe.isJust . IN.toFloat . GN.toInst) rightNodes) + (error "Instruction sub should have numeric right arguments") + + let inputFunc = Maybe.fromJust . IN.toFloat . GN.toInst + result = (inputFunc (head leftNodes)) - (sum (map inputFunc rightNodes)) + mapM_ (GMonad.reLabel (IN.mk (show result))) outNodes + + GMonad.updateIP divI :: GraspM () -divI = GMonad.updateIP +divI = do + curNode <- GMonad.peekIP >>= return . Maybe.fromJust + + leftNodes <- GMonad.nodesOut (EL.mk "left") curNode + rightNodes <- GMonad.nodesOut (EL.mk "right") curNode + outNodes <- GMonad.nodesOut (EL.mk "out") curNode + + Monad.when (length leftNodes /= 1) (error "Instruction div should have one left argument") + Monad.unless (all (Maybe.isJust . IN.toFloat . GN.toInst) leftNodes) + (error "Instruction div should have numeric left arguments") + Monad.unless (all (Maybe.isJust . IN.toFloat . GN.toInst) rightNodes) + (error "Instruction div should have numeric right arguments") + + let inputFunc = Maybe.fromJust . IN.toFloat . GN.toInst + result = (inputFunc (head leftNodes)) / (sum (map inputFunc rightNodes)) + mapM_ (GMonad.reLabel (IN.mk (show result))) outNodes + + GMonad.updateIP modI :: GraspM () -modI = GMonad.updateIP +modI = do + curNode <- GMonad.peekIP >>= return . Maybe.fromJust + + leftNodes <- GMonad.nodesOut (EL.mk "left") curNode + rightNodes <- GMonad.nodesOut (EL.mk "right") curNode + outNodes <- GMonad.nodesOut (EL.mk "out") curNode + + Monad.when (length leftNodes /= 1) (error "Instruction mod should have one left argument") + Monad.when (length rightNodes /= 1) (error "Instruction mod should have one right argument") + Monad.unless (all (Maybe.isJust . IN.toInt . GN.toInst) leftNodes) + (error "Instruction mod should have integer left arguments") + Monad.unless (all (Maybe.isJust . IN.toInt . GN.toInst) rightNodes) + (error "Instruction mod should have integer right arguments") + + let inputFunc = Maybe.fromJust . IN.toInt . GN.toInst + result = (inputFunc (head leftNodes)) `mod` (inputFunc (head rightNodes)) + mapM_ (GMonad.reLabel (IN.mk (show result))) outNodes + + GMonad.updateIP -- cgit