diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Grasp/Interpreter.hs | 88 |
1 files changed, 83 insertions, 5 deletions
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 |