Refactor AST
authorDaniel Schwyn <danielschwyn@gmail.com>
Thu, 11 May 2017 08:50:14 +0000 (10:50 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Tue, 13 Jun 2017 12:20:38 +0000 (14:20 +0200)
Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye2/SockeyeAST.hs
tools/sockeye2/SockeyeChecker.hs
tools/sockeye2/SockeyeParser.hs

index 22fee6e..b477d8a 100644 (file)
@@ -21,19 +21,20 @@ import Numeric (showHex)
 {-
 Nodes are identfied by strings
 -}
-type NodeId = String
+newtype NodeId = NodeId String deriving (Eq, Ord)
 
 {-
 Addresses are natural numbers
 -}
-type Addr = Word
+newtype Addr = Addr Word deriving (Eq, Ord)
 
 {-
 A block is a contigous set of addresses
 -}
-data BlockSpec = BlockSpec { base  :: Addr
-                           , limit :: Addr
-                           } deriving (Ord, Eq)
+data BlockSpec = BlockSpec
+    { base  :: Addr
+    , limit :: Addr
+    } deriving (Eq, Ord)
 
 {-
 A mapping of a source address block to a destination node
@@ -57,25 +58,32 @@ data NodeSpec = NodeSpec { accept    :: [BlockSpec]
 A decoding net is specified as a list 
 of Node IDs mapped to Nodes
 -}
-newtype NetSpec = NetSpec { getNodes :: [(NodeId, NodeSpec)] }
+newtype NetSpec = NetSpec [(NodeId, NodeSpec)]
 
 {- Pretty Printing -}
+instance Show NodeId where
+    show (NodeId id) = id
+
+instance Show Addr where
+    show (Addr addr) = "0x" ++ showHex addr ""
+
 instance Show BlockSpec where
-    show blockSpec = "0x" ++ showHex (base blockSpec) "" ++ "-" ++ "0x" ++ showHex (limit blockSpec) ""
+    show blockSpec = show (base blockSpec) ++ "-" ++ show (limit blockSpec)
 
 instance Show MapSpec where
     show mapSpec = let srcStr  = show $ srcBlock mapSpec
-                       nodeStr = destNode mapSpec
-                       baseStr = "0x" ++ showHex (destBase mapSpec) ""
+                       nodeStr = show $ destNode mapSpec
+                       baseStr = show $ destBase mapSpec
                    in srcStr ++ " to " ++ nodeStr ++ " at " ++ baseStr
 
 instance Show NodeSpec where
     show nodeSpec = let acceptStr    = "accept [" ++ intercalate ", " (map show (accept nodeSpec)) ++ "]"
                         translateStr = "map [" ++ intercalate ", " (map show (translate nodeSpec)) ++ "]"
-                        overlayStr   = case overlay nodeSpec of Nothing     -> ""
-                                                                Just nodeId -> "over " ++ nodeId
+                        overlayStr   = case overlay nodeSpec of
+                                        Nothing     -> ""
+                                        Just nodeId -> "over " ++ show nodeId
                     in acceptStr ++ " " ++ translateStr ++ " " ++ overlayStr
 
 instance Show NetSpec where
-    show netSpec = intercalate "\n" (map nodeStr (getNodes netSpec))
-        where nodeStr (id, node) = id ++ " is " ++ show node
\ No newline at end of file
+    show (NetSpec netSpec) = intercalate "\n" $ map nodeStr netSpec
+                             where nodeStr (id, node) = show id ++ " is " ++ show node
\ No newline at end of file
index aabb416..145b703 100644 (file)
@@ -23,15 +23,18 @@ import qualified Data.Set as Set
 
 import qualified SockeyeAST as AST
 
-findUniqueIdentifiers :: AST.NetSpec -> Writer [String] (Set String)
-findUniqueIdentifiers ast = let allIds = map fst $ AST.getNodes ast
-                            in foldl checkAndAdd (return Set.empty) allIds
-                            where checkAndAdd w id = do
-                                    uids <- w
-                                    tell $ if id `Set.member` uids then ["Duplicate identifier " ++ show id] else []
-                                    return $ id `Set.insert` uids
+findUniqueIdentifiers :: AST.NetSpec -> Writer [String] (Set AST.NodeId)
+findUniqueIdentifiers (AST.NetSpec nodes) = let allIds = map fst $ nodes
+                                            in foldl checkAndAdd (return Set.empty) allIds
+                                            where checkAndAdd w id = do
+                                                    uids <- w
+                                                    tell $ if id `Set.member` uids then
+                                                            ["Duplicate identifier " ++ show id]
+                                                           else
+                                                            []
+                                                    return $ id `Set.insert` uids
 
 checkSockeye :: AST.NetSpec -> [String]
-checkSockeye ast = reverse $ snd $ runWriter $ do
+checkSockeye ast = snd $ runWriter $ do
     ids <- findUniqueIdentifiers ast
     return ids
\ No newline at end of file
index 73ea0fb..e992f44 100644 (file)
@@ -54,8 +54,8 @@ symbol        = P.symbol lexer
 stringLiteral = P.stringLiteral lexer
 commaSep      = P.commaSep lexer
 commaSep1     = P.commaSep1 lexer
-identifier    = P.identifier lexer <?> "node identifier"
-address       = liftM fromIntegral (P.natural lexer) <?> "address"
+identifier    = P.identifier lexer
+natural       = (P.natural lexer)
 decimal       = P.decimal lexer
 
 {- Sockeye parsing -}
@@ -70,11 +70,11 @@ netSpec = do
     node <- nodeSpec
     return $ map (\nodeId -> (nodeId, node)) nodeIds
     where single = do
-            nodeId <- identifier
+            nodeId <- nodeId
             reserved "is"
             return [nodeId]
           multiple = do
-            nodeIds <- commaSep1 identifier
+            nodeIds <- commaSep1 nodeId
             reserved "are"
             return nodeIds
 
@@ -95,27 +95,36 @@ nodeSpec = do
             brackets $ commaSep mapSpec
           parseOverlay = do
             reserved "over"
-            identifier
+            nodeId
 
 mapSpec = do
     srcBlock <- blockSpec
     reserved "to"
-    destNode <- identifier
+    destNode <- nodeId
     reserved "at"
-    destBase <- address
+    destBase <- addr
     return $ AST.MapSpec srcBlock destNode destBase
 
 blockSpec = do
-    base <- address
+    base <- addr
     limit <- option base $ choice [parseLimit, parseLength base]
     return $ AST.BlockSpec base limit
     where parseLimit = do
             symbol "-"
-            address
-          parseLength base = do
+            addr
+          parseLength (AST.Addr base) = do
             symbol "/"
             b <- decimal
-            return $ base + 2^b - 1
+            return $ AST.Addr $ base + 2^b - 1
+
+nodeId = do
+    id <- identifier <?> "node identifier"
+    return $ AST.NodeId id
+
+addr = do
+    addr <- natural <?> "address"
+    return $ AST.Addr $ fromIntegral addr
+
 
 
 parseSockeye :: String -> String -> Either ParseError AST.NetSpec