Refactor to match abstract syntax in paper more closely
authorDaniel Schwyn <danielschwyn@gmail.com>
Wed, 10 May 2017 12:56:41 +0000 (14:56 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Tue, 13 Jun 2017 12:20:25 +0000 (14:20 +0200)
Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye2/Main.hs
tools/sockeye2/SockeyeAST.hs
tools/sockeye2/SockeyeParser.hs

index 1626a6e..c7cfad5 100644 (file)
@@ -59,7 +59,7 @@ compilerOpts argv =
         (_, _, errors)     -> usage errors >> exitWith (ExitFailure 1)
 
 {- Runs the parser -}
-parseFile :: FilePath -> IO (AST.Net)
+parseFile :: FilePath -> IO (AST.NetSpec)
 parseFile file = do
     src <- readFile file
     case parseSockeye file src of
index 0ef684f..22fee6e 100644 (file)
@@ -16,8 +16,6 @@
 module SockeyeAST where
 
 import Data.List
-import Data.Map (Map)
-import qualified Data.Map as Map
 import Numeric (showHex)
 
 {-
@@ -31,45 +29,53 @@ Addresses are natural numbers
 type Addr = Word
 
 {-
-A contigous block of addresses
+A block is a contigous set of addresses
 -}
-data Block = Block { base  :: Addr
-                   , limit :: Addr
-                   } deriving (Ord, Eq)
+data BlockSpec = BlockSpec { base  :: Addr
+                           , limit :: Addr
+                           } deriving (Ord, Eq)
 
 {-
-A name is an address block qualified by a node ID
+A mapping of a source address block to a destination node
+at a base address
 -}
-data Name = Name { nodeId     :: NodeId
-                 , block  :: Block
-                 }
+data MapSpec = MapSpec { srcBlock :: BlockSpec
+                       , destNode :: NodeId
+                       , destBase :: Addr
+                       }
 
 {-
-A node can accept a set of addresses and translate a
-(not necessarily disjoint) set of addresses
+A node is specified as a list of blocks it accepts,
+a list of mappings and possibly an overlay on another block
 -}
-data Node = Node { accept    :: [Block]
-                 , translate :: [(Block, Name)]
-                 }
+data NodeSpec = NodeSpec { accept    :: [BlockSpec]
+                         , translate :: [MapSpec]
+                         , overlay   :: Maybe NodeId
+                         }
 
 {-
-A (decoding) net is a Map from Node IDs to nodes
+A decoding net is specified as a list 
+of Node IDs mapped to Nodes
 -}
-newtype Net = Net { getAssignment :: Map NodeId Node }
+newtype NetSpec = NetSpec { getNodes :: [(NodeId, NodeSpec)] }
 
 {- Pretty Printing -}
-instance Show Block where
-    show block = "0x" ++ showHex (base block) "" ++ "-" ++ "0x" ++ showHex (limit block) ""
-
-instance Show Name where
-    show name = nodeId name ++ " at " ++ show (block name)
-
-instance Show Node where
-    show node = acceptStr node ++ " " ++ translateStr node
-        where acceptStr node = "accept [" ++ intercalate ", " (map show (accept node)) ++ "]"
-              translateStr node = "map [" ++ intercalate ", " (map translationStr (translate node)) ++ "]"
-                where translationStr (fromBlock, name) = show fromBlock ++ " to " ++ show name
-
-instance Show Net where
-    show net = intercalate "\n" (map nodeStr (Map.toList $ getAssignment net))
+instance Show BlockSpec where
+    show blockSpec = "0x" ++ showHex (base blockSpec) "" ++ "-" ++ "0x" ++ showHex (limit blockSpec) ""
+
+instance Show MapSpec where
+    show mapSpec = let srcStr  = show $ srcBlock mapSpec
+                       nodeStr = destNode mapSpec
+                       baseStr = "0x" ++ showHex (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
+                    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
index 26cccf5..cf74b83 100644 (file)
 module SockeyeParser
 ( parseSockeye ) where
 
+import Control.Monad
+
 import Text.ParserCombinators.Parsec as Parsec
 import qualified Text.ParserCombinators.Parsec.Token as P
 import Text.ParserCombinators.Parsec.Language (javaStyle)
 
-import qualified Data.Map as Map
-
-import SockeyeAST as AST
+import qualified SockeyeAST as AST
 
+{- Setup the lexer -}
 lexer = P.makeTokenParser (
     javaStyle  {
         {- list of reserved Names -}
@@ -45,80 +46,68 @@ lexer = P.makeTokenParser (
         P.nestedComments = False
     })
 
-identifier = P.identifier lexer
-reserved = P.reserved lexer
-address = P.natural lexer <?> "address"
-brackets = P.brackets lexer
-symbol = P.symbol lexer
+{- Helper functions -}
+whiteSpace    = P.whiteSpace lexer
+identifier    = P.identifier lexer <?> "node identifier"
+reserved      = P.reserved lexer
+address       = liftM fromIntegral (P.natural lexer) <?> "address"
+brackets      = P.brackets lexer
+symbol        = P.symbol lexer
 stringLiteral = P.stringLiteral lexer
-commaSep = P.commaSep lexer
+commaSep      = P.commaSep lexer
+commaSep1     = P.commaSep1 lexer
 
+{- Sockeye parsing -}
 sockeyeFile = do
-    nodes <- many net
+    whiteSpace
+    nodes <- many netSpec
     eof
-    return $ AST.Net (Map.fromList $ concat nodes)
+    return $ AST.NetSpec $ concat nodes
 
-net = do
-    try single <|> multiple
+netSpec = do
+    nodeIds <- try single <|> multiple
+    node <- nodeSpec
+    return $ map (\nodeId -> (nodeId, node)) nodeIds
     where single = do
             nodeId <- identifier
             reserved "is"
-            node <- node
-            return [(nodeId, node)]
+            return [nodeId]
           multiple = do
-            nodeIds <- commaSep identifier
+            nodeIds <- commaSep1 identifier
             reserved "are"
-            node <- node
-            return $ map (\nodeId -> (nodeId, node)) nodeIds
-
-node = do
-    accept <- try accept <|> return []
-    translate <- try tranlsate <|> return []
-    overlay <- try overlay <|> return Nothing
-    return AST.Node { accept    = accept
-                    , translate = translate
-                    }
-    where accept = do
+            return nodeIds
+
+nodeSpec = do
+    accept <- try parseAccept <|> return []
+    translate <- try parseTranlsate <|> return []
+    overlay <- try parseOverlay <|> return Nothing
+    return $ AST.NodeSpec accept translate overlay
+    where parseAccept = do
             reserved "accept"
-            brackets $ commaSep addrBlock
-          tranlsate = do
+            brackets $ commaSep blockSpec
+          parseTranlsate = do
             reserved "map"
-            brackets $ commaSep mapping
-          overlay = do
+            brackets $ commaSep mapSpec
+          parseOverlay = do
             reserved "over"
             nodeId <- identifier
             return (Just nodeId)
 
-
-mapping = do
-    fromBlock <- addrBlock
+mapSpec = do
+    srcBlock <- blockSpec
     reserved "to"
-    name <- name
-    return (fromBlock, name)
-
-name = do
-    nodeId <- identifier
+    destNode <- identifier
     reserved "at"
-    block <- addrBlock
-    return AST.Name { nodeId = nodeId
-                    , block  = block
-                    }
-
-addrBlock = do
-    try realBlock
-    <|> singletonBlock
-    where realBlock = do
-            base <- address
+    destBase <- address
+    return $ AST.MapSpec srcBlock destNode destBase
+
+blockSpec = do
+    base <- address
+    limit <- try parseLimit <|> return base
+    return $ AST.BlockSpec base limit
+    where parseLimit = do
             symbol "-"
-            limit <- address
-            return AST.Block { base  = fromIntegral base
-                             , limit = fromIntegral limit
-                             }
-          singletonBlock = do
-            address <- address
-            return AST.Block { base  = fromIntegral address
-                             , limit = fromIntegral address
-                             }
-
-parseSockeye :: String -> String -> Either ParseError AST.Net
+            address
+
+parseSockeye :: String -> String -> Either ParseError AST.NetSpec
 parseSockeye = parse sockeyeFile