From 1d1e603683e63a59734adf57b3500217945b17c6 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sat, 6 Dec 2014 23:00:03 +1100
Subject: set and del instructions added
---
src/Grasp/Interpreter.hs | 92 +++++++++++++++++++++++++++++++++---------------
src/Grasp/Monad.hs | 26 ++++++++++++--
2 files changed, 88 insertions(+), 30 deletions(-)
(limited to 'src')
diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs
index d6c1f80..40bc028 100644
--- a/src/Grasp/Interpreter.hs
+++ b/src/Grasp/Interpreter.hs
@@ -5,10 +5,17 @@ module Grasp.Interpreter (
+import qualified System.Random as Random
+
import qualified Control.Monad as Monad
+import Control.Monad.IO.Class( liftIO )
+
import qualified Data.Maybe as Maybe
+import Data.List( (!!) )
+import qualified Data.List as List
+
import Grasp.Monad( GraspM )
import qualified Grasp.Monad as GMonad
@@ -21,6 +28,9 @@ import qualified Grasp.Types.GEdge as GE
import Grasp.Types.Instruction( Instruction )
import qualified Grasp.Types.Instruction as IN
+import Grasp.Types.EdgeLabel( EdgeLabel )
+import qualified Grasp.Types.EdgeLabel as EL
+
@@ -31,42 +41,68 @@ grasp input = GMonad.finalise $ GMonad.construct input >> interpret
interpret :: GraspM ()
interpret = do
- n <- GMonad.peekIP
-
- if (Maybe.isNothing n) then return () else do
- case (IN.toString . GN.toInst . Maybe.fromJust $ n) of
- "set" -> setI
- "new" -> newI
- "del" -> delI
- "push" -> pushI
- "pop" -> popI
- "pick" -> pickI
- "call" -> callI
- "ret" -> retI
- "add" -> addI
- "mul" -> mulI
- "sub" -> subI
- "div" -> divI
- "mod" -> modI
- "getc" -> getcI
- "putc" -> putcI
- "gets" -> getsI
- "puts" -> putsI
- inst | Maybe.isJust . IN.toInt . IN.mk $ inst -> implicitPushI
- x -> error ("Unknown instruction " ++ x)
-
- GMonad.nextIP
- interpret
+ n <- GMonad.peekIP
+
+ if (Maybe.isNothing n) then return () else do
+ case (IN.toString . GN.toInst . Maybe.fromJust $ n) of
+ "set" -> setI
+ "new" -> newI
+ "del" -> delI
+ "push" -> pushI
+ "pop" -> popI
+ "pick" -> pickI
+ "call" -> callI
+ "ret" -> retI
+ "add" -> addI
+ "mul" -> mulI
+ "sub" -> subI
+ "div" -> divI
+ "mod" -> modI
+ "getc" -> getcI
+ "putc" -> putcI
+ "gets" -> getsI
+ "puts" -> putsI
+ inst | Maybe.isJust . IN.toInt . IN.mk $ inst -> implicitPushI
+ x -> error ("Unknown instruction " ++ x)
+
+ GMonad.nextIP
+ interpret
setI :: GraspM ()
-setI = GMonad.updateIP
+setI = do
+ curNode <- GMonad.peekIP >>= return . Maybe.fromJust
+
+ inNodes <- GMonad.nodesOut (EL.mk "in") curNode
+ outNodes <- GMonad.nodesOut (EL.mk "out") curNode
+
+ Monad.when (length inNodes /= 0) (do
+ r <- liftIO (Random.getStdRandom (Random.randomR (0, length inNodes - 1)))
+ mapM_ (GMonad.reLabel (GN.toInst (inNodes !! r))) outNodes )
+
+ GMonad.updateIP
newI :: GraspM ()
-newI = GMonad.updateIP
+newI = do
+ curNode <- GMonad.peekIP >>= return . Maybe.fromJust
+
+ tailNodes <- GMonad.nodesOut (EL.mk "tail") curNode
+ headNodes <- GMonad.nodesOut (EL.mk "head") curNode
+ labelNodes <- GMonad.nodesOut (EL.mk "label") curNode
+
+ Monad.when (length tailNodes /= 1) (error "Instruction new should have one tail argument")
+ Monad.when (length headNodes /= 1) (error "Instruction new should have one head argument")
+ Monad.when (length labelNodes /= 1) (error "Instruction new should have one label argument")
+ Monad.when (Maybe.isJust . IN.toFloat . GN.toInst $ (head labelNodes))
+ (error "Label argument to instruction new should not be a number")
+
+ let edgeLabel = EL.mk . IN.toString . GN.toInst $ (head labelNodes)
+ GMonad.insEdge (GE.mk (GN.toNode (head tailNodes), GN.toNode (head headNodes), edgeLabel))
+
+ GMonad.updateIP
diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index b49b53d..e58aa74 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -13,7 +13,9 @@ module Grasp.Monad (
peekIP,
nextIP,
- nodesOut
+ nodesOut,
+ reLabel,
+ insEdge
) where
@@ -39,7 +41,7 @@ import qualified Data.List as List
import Data.Map( Map )
import qualified Data.Map as Map
-import Grasp.Graph( Node, LNode, LEdge, Gr )
+import Grasp.Graph( Node, LNode, LEdge, Gr, (&) )
import qualified Grasp.Graph as Graph
import Grasp.Types.IP( IP )
@@ -309,3 +311,23 @@ nodesOut s n = do
if (Maybe.isNothing curNode) then return [] else return result
+
+
+reLabel :: Instruction -> GNode -> GraspM ()
+reLabel i n = do
+ (gr, ips, fh) <- State.get
+
+ let (mc, d) = Graph.match (GN.toNode n) gr
+ c = Maybe.fromJust mc
+ c' = (\(w,x,y,z) -> (w,x,i,z)) $ c
+
+ Monad.when (Maybe.isJust mc) (State.put ((c' & d) ,ips, fh))
+
+
+
+insEdge :: GEdge -> GraspM ()
+insEdge e = do
+ (gr, ips, fh) <- State.get
+ let gr' = Graph.insEdge (GE.toLEdge e) gr
+ State.put (gr', ips, fh)
+
--
cgit