summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Grasp/Interpreter.hs17
-rw-r--r--src/Grasp/Monad.hs41
2 files changed, 55 insertions, 3 deletions
diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs
index 0d24ce1..bca167a 100644
--- a/src/Grasp/Interpreter.hs
+++ b/src/Grasp/Interpreter.hs
@@ -112,7 +112,22 @@ newI = do
delI :: GraspM ()
-delI = GMonad.updateIP
+delI = 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 /= 0) (do
+ input <- mapM GMonad.edgesOut tailNodes >>= return . concat
+ let labels = map (EL.mk . IN.toString . GN.toInst) labelNodes
+ heads = map GN.toNode headNodes
+ result = filter (\x -> (length headNodes == 0 || GE.toDest x `elem` heads) &&
+ (length labelNodes == 0 || GE.toLabel x `elem` labels)) input
+ GMonad.delEdges result )
+
+ GMonad.updateIP
diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index e58aa74..ba500af 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -13,9 +13,10 @@ module Grasp.Monad (
peekIP,
nextIP,
- nodesOut,
+ nodesOut, edgesOut,
reLabel,
- insEdge
+ insEdge, insEdges,
+ delEdge, delEdges
) where
@@ -313,6 +314,18 @@ nodesOut s n = do
+edgesOut :: GNode -> GraspM [GEdge]
+edgesOut n = do
+ (gr, ips, fh) <- State.get
+ curNode <- peekIP
+
+ let eout = Graph.out gr (GN.toNode (Maybe.fromJust curNode))
+ result = map GE.mk eout
+
+ if (Maybe.isNothing curNode) then return [] else return result
+
+
+
reLabel :: Instruction -> GNode -> GraspM ()
reLabel i n = do
(gr, ips, fh) <- State.get
@@ -331,3 +344,27 @@ insEdge e = do
let gr' = Graph.insEdge (GE.toLEdge e) gr
State.put (gr', ips, fh)
+
+
+insEdges :: [GEdge] -> GraspM ()
+insEdges es = do
+ (gr, ips, fh) <- State.get
+ let gr' = Graph.insEdges (map GE.toLEdge es) gr
+ State.put (gr', ips, fh)
+
+
+
+delEdge :: GEdge -> GraspM ()
+delEdge e = do
+ (gr, ips, fh) <- State.get
+ let gr' = Graph.delLEdge (GE.toLEdge e) gr
+ State.put (gr', ips, fh)
+
+
+
+delEdges :: [GEdge] -> GraspM ()
+delEdges es = do
+ (gr, ips, fh) <- State.get
+ let gr' = List.foldl' (flip Graph.delLEdge) gr (map GE.toLEdge es)
+ State.put (gr', ips, fh)
+