new instruction complete

1 files changed, 79 insertions, 48 deletions

diff --git a/src/Grasp/Interpreter.hs b/src/Grasp/Interpreter.hs
index 965aa13..e8896cf 100644
--- a/src/Grasp/Interpreter.hs
+++ b/src/Grasp/Interpreter.hs
@@ -3,6 +3,7 @@ module Grasp.Interpreter (
     ) where
 
 
+import System.Random
 import Text.Read( readMaybe )
 import Data.Graph.Inductive.Graph( Node, LNode, LEdge, (&) )
 import qualified Data.Graph.Inductive.Graph as Graph
@@ -20,32 +21,32 @@ type IP = [LNode String]
 
 grasp :: GraspProgram -> IO ()
 grasp g =
-	let ips = map (:[]) (nodesWithName g "grasp:main")
-	in interpret g ips
+    let ips = map (:[]) (nodesWithName g "grasp:main")
+    in interpret g ips
 
 
 
 reachable :: GraspProgram -> [IP] -> [Node]
 reachable g ips =
-	let startNodes = nub . (map fst) $ (namedNodes g) ++ (concat ips)
-	in reach g startNodes []
+    let startNodes = nub . (map fst) $ (namedNodes g) ++ (concat ips)
+    in reach g startNodes []
 
 
 
 reach :: GraspProgram -> [Node] -> [Node] -> [Node]
 reach _ [] f = f
 reach g s@(x:xs) f =
-	let f' = nub (x:f)
-	    s' = nub (xs ++ (Graph.suc g x))
-	    g' = Graph.delNode x g
-	in reach g' s' f'
+    let f' = nub (x:f)
+        s' = nub (xs ++ (Graph.suc g x))
+        g' = Graph.delNode x g
+    in reach g' s' f'
 
 
 
 garbageCollect :: GraspProgram -> [IP] -> GraspProgram
 garbageCollect g ips =
-	let unreachable = (Graph.nodes g) \\ (reachable g ips)
-	in Graph.delNodes unreachable g
+    let unreachable = (Graph.nodes g) \\ (reachable g ips)
+    in Graph.delNodes unreachable g
 
 
 
@@ -58,29 +59,29 @@ execute :: GraspProgram -> [IP] -> [IP] -> IO ()
 execute g [] out = interpret g (reverse out)
 execute g ([]:ips) out = execute g ips out
 execute g (cur:rest) out = do
-	(g', cur') <-
-		    case (snd . head $ cur) of
-		        "set" -> setI g cur
-		        "new" -> newI g cur
-		        "del" -> delI g cur
-		        "push" -> pushI g cur
-		        "pop" -> popI g cur
-		        "pick" -> pickI g cur
-		        "call" -> callI g cur
-		        "ret" -> retI g cur
-		        "add" -> addI g cur
-		        "mul" -> mulI g cur
-		        "sub" -> subI g cur
-		        "div" -> divI g cur
-		        "mod" -> modI g cur
-		        "getc" -> getcI g cur
-		        "putc" -> putcI g cur
-		        "gets" -> getsI g cur
-		        "puts" -> putsI g cur
-
-		        x | isInteger x -> implicitPushI g cur
-
-		        x -> error ("Unknown instruction at " ++ (show x))
+    (g', cur') <-
+            case (snd . head $ cur) of
+                "set" -> setI g cur
+                "new" -> newI g cur
+                "del" -> delI g cur
+                "push" -> pushI g cur
+                "pop" -> popI g cur
+                "pick" -> pickI g cur
+                "call" -> callI g cur
+                "ret" -> retI g cur
+                "add" -> addI g cur
+                "mul" -> mulI g cur
+                "sub" -> subI g cur
+                "div" -> divI g cur
+                "mod" -> modI g cur
+                "getc" -> getcI g cur
+                "putc" -> putcI g cur
+                "gets" -> getsI g cur
+                "puts" -> putsI g cur
+
+                x | isInteger x -> implicitPushI g cur
+
+                x -> error ("Unknown instruction at " ++ (show x))
 
     execute g' rest (cur':out)
 
@@ -88,17 +89,24 @@ execute g (cur:rest) out = do
 
 isInteger :: String -> Bool
 isInteger x =
-	let check = readMaybe x :: Maybe Int
-	in if (isJust check) then True else False
+    let check = readMaybe x :: Maybe Int
+    in if (isJust check) then True else False
+
+
+
+isFloat :: String -> Bool
+isFloat x =
+    let check = readMaybe x :: Maybe Float
+    in if (isJust check) then True else False
 
 
 
 reLabel :: GraspProgram -> Node -> String -> GraspProgram
 reLabel g n s =
-	let (mc,d) = Graph.match n g
-	    c = fromJust mc
-	    c' = (\(w,x,y,z) -> (w,x,s,z)) $ c
-	in if (isNothing mc) then g else c' & d
+    let (mc,d) = Graph.match n g
+        c = fromJust mc
+        c' = (\(w,x,y,z) -> (w,x,s,z)) $ c
+    in if (isNothing mc) then g else c' & d
 
 
 
@@ -121,23 +129,23 @@ targetLNodes g = map (\(_,x,_) -> (x, fromJust (Graph.lab g x)) )
 updateIP :: IP -> [LNode String] -> IO IP
 updateIP _ [] = return []
 updateIP ip next =
-	getStdRandom (randomR (0,length next)) >>=
-	(\x -> return ((next !! x):(tail ip)) )
+    getStdRandom (randomR (0,length next)) >>=
+    (\x -> return ((next !! x):(tail ip)) )
 
 
 
 setI :: GraspProgram -> IP -> IO (GraspProgram, IP)
 setI g ip = do
-	let edges = Graph.out g (fst . head $ ip)
+    let edges = Graph.out g (fst . head $ ip)
 
         inL = targetLabels g (getByLabel "in" edges)
         outN = targetNodes (getByLabel "out" edges)
         nextLN = targetLNodes g (getByLabel "next" edges)
-	
-	g' <- case inL of
-		    [] -> return g
-		    _ -> (getStdRandom (randomR (0,length inL))) >>=
-		    	(\x -> foldl' (\g n -> reLabel g n (inL !! x)) (return g) outN)
+    
+    g' <- case inL of
+            [] -> return g
+            _ -> (getStdRandom (randomR (0,length inL))) >>=
+                (\x -> return (foldl' (\g n -> reLabel g n (inL !! x)) g outN) )
     
     ip' <- updateIP ip nextLN
 
@@ -146,7 +154,30 @@ setI g ip = do
 
 
 newI :: GraspProgram -> IP -> IO (GraspProgram, IP)
-newI g ip = return (g,ip)
+newI g ip = do
+    let node = fst . head $ ip
+        edges = Graph.out g node
+
+        tailN = targetNodes (getByLabel "tail" edges)
+        headN = targetNodes (getByLabel "head" edges)
+        labelL = targetLabels g (getByLabel "label" edges)
+
+    g' <- case (tailN, headN, labelL) of
+            (x,_,_) | length x /= 1 -> error ("Instruction " ++ (show node) ++
+                                              " should only have one tail argument")
+            (_,y,_) | length y /= 1 -> error ("Instruction " ++ (show node) ++
+                                              " should only have one head argument")
+            (_,_,z) | length z /= 1 -> error ("Instruction " ++ (show node) ++
+                                              " should only have one label argument")
+            (_,_,z) | isFloat (head z) -> error ("Instruction " ++ (show node) ++
+                                                 " should have non-numeric label argument")
+            (x,y,z) -> return (Graph.insEdge (head x, head y, head z) g)
+
+    ip' <- updateIP ip (targetLNodes g' (getByLabel "next" (Graph.out g' node)))
+
+    return (g',ip')
+
+
 
 delI :: GraspProgram -> IP -> IO (GraspProgram, IP)
 delI g ip = return (g,ip)