summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Grasp/GNode.hs60
-rw-r--r--src/Grasp/Monad.hs34
-rw-r--r--src/Grasp/Parser.hs20
-rw-r--r--src/Grasp/Types/EdgeLabel.hs23
-rw-r--r--src/Grasp/Types/GEdge.hs (renamed from src/Grasp/GEdge.hs)31
-rw-r--r--src/Grasp/Types/GNode.hs37
-rw-r--r--src/Grasp/Types/IP.hs (renamed from src/Grasp/IP.hs)4
-rw-r--r--src/Grasp/Types/Instruction.hs32
8 files changed, 136 insertions, 105 deletions
diff --git a/src/Grasp/GNode.hs b/src/Grasp/GNode.hs
deleted file mode 100644
index 3c8161e..0000000
--- a/src/Grasp/GNode.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-module Grasp.GNode (
- GNode,
- Instruction,
-
- mkGNode,
- mkInst,
-
- toNode,
- toInst,
- toLNode,
-
- instToFloat
- ) where
-
-
-
-
-import Grasp.Graph( Node, LNode )
-import Text.Read( readMaybe )
-
-
-
-
-newtype Instruction = Instruction String
- deriving (Show, Eq)
-
-newtype GNode = GNode (LNode Instruction)
- deriving (Show, Eq)
-
-
-
-
-mkGNode :: LNode Instruction -> GNode
-mkGNode = GNode
-
-
-
-mkInst :: String -> Instruction
-mkInst = Instruction
-
-
-
-toNode :: GNode -> Node
-toNode (GNode n) = fst n
-
-
-
-toInst :: GNode -> Instruction
-toInst (GNode n) = snd n
-
-
-
-toLNode :: GNode -> LNode Instruction
-toLNode (GNode n) = n
-
-
-
-instToFloat :: Instruction -> Maybe Float
-instToFloat (Instruction i) = readMaybe i
-
diff --git a/src/Grasp/Monad.hs b/src/Grasp/Monad.hs
index 9b0d65a..d8ffff8 100644
--- a/src/Grasp/Monad.hs
+++ b/src/Grasp/Monad.hs
@@ -18,6 +18,7 @@ module Grasp.Monad (
+
import System.IO( Handle, FilePath, IOMode )
import qualified System.IO as IO
@@ -40,14 +41,20 @@ import qualified Data.Map as Map
import Grasp.Graph( Node, LNode, LEdge, Gr )
import qualified Grasp.Graph as Graph
-import Grasp.IP( IP )
-import qualified Grasp.IP as IP
+import Grasp.Types.IP( IP )
+import qualified Grasp.Types.IP as IP
+
+import Grasp.Types.GNode( GNode )
+import qualified Grasp.Types.GNode as GN
-import Grasp.GNode( GNode, Instruction )
-import qualified Grasp.GNode as GN
+import Grasp.Types.GEdge( GEdge )
+import qualified Grasp.Types.GEdge as GE
-import Grasp.GEdge( GEdge, EdgeLabel )
-import qualified Grasp.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
@@ -56,6 +63,7 @@ type GraspM a = StateT GraspProgram IO a
+
data GraspProgram = GraspProgram { programGraph :: Gr Instruction EdgeLabel
, instPtrs :: [IP]
, fileHandles :: Map FilePath Handle }
@@ -86,7 +94,7 @@ finalise s = do
(mapM_ IO.hClose) . Map.elems . fileHandles $ p
let gr = programGraph p
(nodes, edges) = (Graph.labNodes gr, Graph.labEdges gr)
- return (map GN.mkGNode nodes, map GE.mkGEdge edges)
+ return (map GN.mk nodes, map GE.mk edges)
@@ -113,14 +121,14 @@ multiNames ns es =
numericName :: [GNode] -> [GEdge] -> Bool
numericName ns es =
let names = map snd (nameNodeList ns es)
- in any (\x -> Maybe.isJust (GN.instToFloat (GN.toInst x))) names
+ in any (\x -> Maybe.isJust (IN.toFloat (GN.toInst x))) names
noMain :: [GNode] -> [GEdge] -> Bool
noMain ns es =
let names = map snd (nameNodeList ns es)
- mains = filter ((== (GN.mkInst "grasp:main")) . GN.toInst) names
+ mains = filter ((== (IN.mk "grasp:main")) . GN.toInst) names
in length mains /= 0
@@ -172,7 +180,7 @@ getReadHandle path = do
-- fix this later so it doesn't required unconnected edge checking first
nameNodeList :: [GNode] -> [GEdge] -> [(GNode,GNode)]
nameNodeList ns es =
- let nameEdges = filter ((== (GE.mkLabel "name")) . GE.toLabel) es
+ let nameEdges = filter ((== (EL.mk "name")) . GE.toLabel) es
findNode n = Maybe.fromJust (List.find ((== n) . GN.toNode) ns)
in map (\x -> (findNode (GE.toSrc x), findNode (GE.toDest x))) nameEdges
@@ -180,7 +188,7 @@ nameNodeList ns es =
nodesWithName :: [GNode] -> [GEdge] -> String -> [GNode]
nodesWithName ns es name =
- (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (GN.mkInst name))) $ (nameNodeList ns es)
+ (map fst) . (filter (\x -> (GN.toInst . snd $ x) == (IN.mk name))) $ (nameNodeList ns es)
@@ -189,7 +197,7 @@ updateIP = do
program <- State.get
curNode <- peekIP
Monad.when (Maybe.isJust curNode) (do
- nexts <- nodesOut (GE.mkLabel "next") (Maybe.fromJust curNode)
+ nexts <- nodesOut (EL.mk "next") (Maybe.fromJust curNode)
r <- liftIO (Random.getStdRandom (Random.randomR (0, length nexts - 1)))
let ips = instPtrs program
@@ -247,7 +255,7 @@ nodesOut s n = do
let gr = programGraph program
nout = Graph.lsuc gr (GN.toNode (Maybe.fromJust curNode))
filtered = filter ((== s) . snd) nout
- result = map (\(x,y) -> GN.mkGNode (x, Maybe.fromJust (Graph.lab gr x))) filtered
+ result = map (\(x,y) -> GN.mk (x, Maybe.fromJust (Graph.lab gr x))) filtered
if (Maybe.isNothing curNode) then return [] else return result
diff --git a/src/Grasp/Parser.hs b/src/Grasp/Parser.hs
index 86a1858..7274919 100644
--- a/src/Grasp/Parser.hs
+++ b/src/Grasp/Parser.hs
@@ -3,15 +3,23 @@ module Grasp.Parser (
) where
+
+
import Control.Applicative( some )
import Data.Char( toLower, toUpper )
import Text.ParserCombinators.Parsec
-import Grasp.GNode( GNode )
-import qualified Grasp.GNode as GN
+import Grasp.Types.GNode( GNode )
+import qualified Grasp.Types.GNode as GN
+
+import Grasp.Types.GEdge( GEdge )
+import qualified Grasp.Types.GEdge as GE
+
+import Grasp.Types.Instruction( Instruction )
+import qualified Grasp.Types.Instruction as IN
-import Grasp.GEdge( GEdge )
-import qualified Grasp.GEdge as GE
+import Grasp.Types.EdgeLabel( EdgeLabel )
+import qualified Grasp.Types.EdgeLabel as EL
@@ -130,7 +138,7 @@ node = do
a <- attrList
optional (char ';')
whiteSpace
- return (GN.mkGNode (n, GN.mkInst a))
+ return (GN.mk (n, IN.mk a))
edge = do
@@ -140,7 +148,7 @@ edge = do
c <- attrList
optional (char ';')
whiteSpace
- return (GE.mkGEdge (a,b, GE.mkLabel c))
+ return (GE.mk (a,b, EL.mk c))
edgeOp = string "->" >> whiteSpace >> return "->"
diff --git a/src/Grasp/Types/EdgeLabel.hs b/src/Grasp/Types/EdgeLabel.hs
new file mode 100644
index 0000000..4fbdd27
--- /dev/null
+++ b/src/Grasp/Types/EdgeLabel.hs
@@ -0,0 +1,23 @@
+module Grasp.Types.EdgeLabel (
+ EdgeLabel,
+
+ mk,
+
+ toString
+ ) where
+
+
+
+
+newtype EdgeLabel = EdgeLabel String
+ deriving (Show, Eq)
+
+
+
+
+mk :: String -> EdgeLabel
+mk = EdgeLabel
+
+toString :: EdgeLabel -> String
+toString (EdgeLabel e) = e
+
diff --git a/src/Grasp/GEdge.hs b/src/Grasp/Types/GEdge.hs
index fcd826a..38ce596 100644
--- a/src/Grasp/GEdge.hs
+++ b/src/Grasp/Types/GEdge.hs
@@ -1,9 +1,7 @@
-module Grasp.GEdge (
+module Grasp.Types.GEdge (
GEdge,
- EdgeLabel,
- mkGEdge,
- mkLabel,
+ mk,
toSrc,
toDest,
@@ -15,44 +13,29 @@ module Grasp.GEdge (
import Grasp.Graph( Node, LEdge )
+import Grasp.Types.EdgeLabel( EdgeLabel )
-newtype EdgeLabel = EdgeLabel String
- deriving (Show, Eq)
-
newtype GEdge = GEdge (LEdge EdgeLabel)
deriving (Show, Eq)
-mkGEdge :: LEdge EdgeLabel -> GEdge
-mkGEdge = GEdge
-
-
-
-mkLabel :: String -> EdgeLabel
-mkLabel = EdgeLabel
-
-
+mk :: LEdge EdgeLabel -> GEdge
+mk = GEdge
-toSrc :: GEdge -> String
+toSrc :: GEdge -> Node
toSrc (GEdge (x,_,_)) = x
-
-
-toDest :: GEdge -> String
+toDest :: GEdge -> Node
toDest (GEdge (_,y,_)) = y
-
-
toLabel :: GEdge -> EdgeLabel
toLabel (GEdge (_,_,z)) = z
-
-
toLEdge :: GEdge -> LEdge EdgeLabel
toLEdge (GEdge e) = e
diff --git a/src/Grasp/Types/GNode.hs b/src/Grasp/Types/GNode.hs
new file mode 100644
index 0000000..92c070e
--- /dev/null
+++ b/src/Grasp/Types/GNode.hs
@@ -0,0 +1,37 @@
+module Grasp.Types.GNode (
+ GNode,
+
+ mk,
+
+ toNode,
+ toInst,
+ toLNode
+ ) where
+
+
+
+
+import Grasp.Graph( Node, LNode )
+import Grasp.Types.Instruction( Instruction )
+
+
+
+
+newtype GNode = GNode (LNode Instruction)
+ deriving (Show, Eq)
+
+
+
+
+mk :: LNode Instruction -> GNode
+mk = GNode
+
+toNode :: GNode -> Node
+toNode (GNode n) = fst n
+
+toInst :: GNode -> Instruction
+toInst (GNode n) = snd n
+
+toLNode :: GNode -> LNode Instruction
+toLNode (GNode n) = n
+
diff --git a/src/Grasp/IP.hs b/src/Grasp/Types/IP.hs
index 4f042a1..c7d3e4b 100644
--- a/src/Grasp/IP.hs
+++ b/src/Grasp/Types/IP.hs
@@ -1,4 +1,4 @@
-module Grasp.IP (
+module Grasp.Types.IP (
IP,
singleton,
@@ -13,7 +13,7 @@ module Grasp.IP (
-import Grasp.GNode( GNode )
+import Grasp.Types.GNode( GNode )
diff --git a/src/Grasp/Types/Instruction.hs b/src/Grasp/Types/Instruction.hs
new file mode 100644
index 0000000..0ff4002
--- /dev/null
+++ b/src/Grasp/Types/Instruction.hs
@@ -0,0 +1,32 @@
+module Grasp.Types.Instruction (
+ Instruction,
+
+ mk,
+
+ toString,
+ toFloat
+ ) where
+
+
+
+
+import Text.Read( readMaybe )
+
+
+
+
+newtype Instruction = Instruction String
+ deriving (Show, Eq)
+
+
+
+
+mk :: String -> Instruction
+mk = Instruction
+
+toString :: Instruction -> String
+toString (Instruction i) = i
+
+toFloat :: Instruction -> Maybe Float
+toFloat (Instruction i) = readMaybe i
+
generated by cgit (git 2.30.0) at 2024-12-22 12:30:18 +0000