Sockeye: Start implementation of net builder
authorDaniel Schwyn <schwyda@student.ethz.ch>
Tue, 11 Jul 2017 12:44:04 +0000 (14:44 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Tue, 11 Jul 2017 12:44:04 +0000 (14:44 +0200)
TODO:
- Node specs
- Port mappings
- Checks

Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye/Main.hs
tools/sockeye/SockeyeASTDecodingNet.hs
tools/sockeye/SockeyeASTDecodingNetOld.hs [new file with mode: 0644]
tools/sockeye/SockeyeBackendProlog.hs
tools/sockeye/SockeyeNetBuilder.hs

index 1046e18..26f5041 100644 (file)
@@ -151,9 +151,9 @@ buildNet ast = do
         Right netAst -> return netAst
 
 {- Compiles the AST with the appropriate backend -}
-compile :: Target -> NetAST.NetSpec -> IO String
-compile None     _   = return ""
-compile Prolog   ast = return $ Prolog.compile ast
+-- compile :: Target -> NetAST.NetSpec -> IO String
+-- compile None     _   = return ""
+-- compile Prolog   ast = return $ Prolog.compile ast
 
 {- Outputs the compilation result -}
 output :: Maybe FilePath -> String -> IO ()
@@ -168,8 +168,9 @@ main = do
     let inFile = optInputFile opts
     parsedAst <- parseFile inFile
     ast <- checkAST parsedAst
+    -- putStrLn $ groom ast ++ "\n"
     netAst <- buildNet ast
     putStrLn $ groom netAst
-    out <- compile (optTarget opts) netAst
-    output (optOutputFile opts) out
+    -- out <- compile (optTarget opts) netAst
+    -- output (optOutputFile opts) out
     
\ No newline at end of file
index 10bccf2..ea751e9 100644 (file)
 
 module SockeyeASTDecodingNet where
 
+import Data.Map(Map)
+
 {-
-Nodes are identfied by strings
+Nodes are identfied by a namespace and a name
 -}
-newtype NodeId = NodeId String
-  deriving (Eq, Ord, Show)
+data NodeId = NodeId
+    { namespace :: [String]
+    , name      :: !String
+    } deriving (Eq, Ord, Show)
 
 {-
 Addresses are natural numbers
@@ -73,5 +77,5 @@ data NodeSpec = NodeSpec
 A decoding net is specified as a list 
 of Node IDs mapped to Nodes
 -}
-newtype NetSpec = NetSpec [(NodeId, NodeSpec)]
+newtype NetSpec = NetSpec (Map NodeId NodeSpec)
     deriving (Show)
diff --git a/tools/sockeye/SockeyeASTDecodingNetOld.hs b/tools/sockeye/SockeyeASTDecodingNetOld.hs
new file mode 100644 (file)
index 0000000..7e21e6f
--- /dev/null
@@ -0,0 +1,77 @@
+{-
+  SockeyeASTDecodingNet.hs: Decoding net AST for Sockeye
+
+  Part of Sockeye
+
+  Copyright (c) 2017, ETH Zurich.
+
+  All rights reserved.
+
+  This file is distributed under the terms in the attached LICENSE file.
+  If you do not find this file, copies can be found by writing to:
+  ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
+  Attn: Systems Group.
+-}
+
+module SockeyeASTDecodingNetOld where
+
+{-
+Nodes are identfied by strings
+-}
+newtype NodeId = NodeId String
+  deriving (Eq, Ord, Show)
+
+{-
+Addresses are natural numbers
+-}
+newtype Addr = Addr Word
+  deriving (Eq, Ord, Show)
+
+{-
+A block is a contigous set of addresses
+-}
+data BlockSpec = BlockSpec
+    { base  :: Addr
+    , limit :: Addr
+    } deriving (Eq, Ord, Show)
+
+{-
+A mapping of a source address block to a destination node
+at a base address
+-}
+data MapSpec = MapSpec
+    { srcBlock :: BlockSpec
+    , destNode :: NodeId
+    , destBase :: Addr
+    } deriving (Show)
+
+{-
+Node can either be memory, device or other
+-}
+data NodeType
+    = Memory
+    | Device
+    | Other
+
+instance Show NodeType where
+    show Memory = "memory"
+    show Device = "device"
+    show Other  = "other"
+
+{-
+A node is specified as a list of blocks it accepts,
+a list of mappings and possibly an overlay on another block
+-}
+data NodeSpec = NodeSpec
+    { nodeType  :: NodeType
+    , accept    :: [BlockSpec]
+    , translate :: [MapSpec]
+    , overlay   :: Maybe NodeId
+    } deriving (Show)
+
+{-
+A decoding net is specified as a list 
+of Node IDs mapped to Nodes
+-}
+newtype NetSpec = NetSpec [(NodeId, NodeSpec)]
+    deriving (Show)
index dffd567..f71360f 100644 (file)
@@ -20,7 +20,7 @@ import Data.List
 import Data.Char
 import Numeric (showHex)
 
-import qualified SockeyeASTDecodingNet as AST
+import qualified SockeyeASTDecodingNetOld as AST
 
 compile :: AST.NetSpec -> String
 compile = generate
index a861b1a..c9e18b6 100644 (file)
 module SockeyeNetBuilder
 ( sockeyeBuildNet ) where
 
+import Data.Either
+
+import Data.Map (Map)
 import qualified Data.Map as Map
 
 import qualified SockeyeAST as AST
 import qualified SockeyeASTDecodingNet as NetAST
 
+import Debug.Trace
+
+type NetList = [(NetAST.NodeId, NetAST.NodeSpec)]
+
 newtype CheckFailure = CheckFailure
     { message :: String }
 
 instance Show CheckFailure where
     show f = unlines $ ["", message f]
 
+data Context = Context
+    { spec        :: AST.SockeyeSpec
+    , paramValues :: Map String Word
+    , varValues   :: Map String Word
+    }
+
 sockeyeBuildNet :: AST.SockeyeSpec -> Either CheckFailure NetAST.NetSpec
-sockeyeBuildNet ast = buildNet ast
+sockeyeBuildNet ast = do
+    let
+        emptySpec = AST.SockeyeSpec Map.empty
+        context = Context
+            { spec        = emptySpec
+            , paramValues = Map.empty
+            , varValues   = Map.empty
+            }
+    net <- buildNet context ast
+    -- TODO: check duplicates
+    let
+        nodeMap = Map.fromList net
+    -- TODO: check references
+    return $ NetAST.NetSpec nodeMap
 
 class NetSource a b where
-    buildNet :: a -> Either CheckFailure b
+    buildNet :: Context -> a -> Either CheckFailure b
 
-instance NetSource AST.SockeyeSpec NetAST.NetSpec where
-    buildNet ast = do
+instance NetSource AST.SockeyeSpec NetList where
+    buildNet context ast = do
         let
             rootInst = AST.ModuleInst
                 { AST.nameSpace  = AST.SimpleIdent ""
@@ -47,7 +73,146 @@ instance NetSource AST.SockeyeSpec NetAST.NetSpec where
                 , AST.inPortMap  = []
                 , AST.outPortMap = []
                 }
-        buildNet rootInst
+            specContext = context
+                { spec = ast }
+        buildNet specContext rootInst
+
+instance NetSource AST.ModuleInst NetList where
+    buildNet context (AST.MultiModuleInst for) = buildNet context for
+    buildNet context ast = do
+        let
+            nameSpace = AST.nameSpace ast
+            name = AST.moduleName ast
+            args = AST.arguments ast
+            mod = getModule context name
+            nodeDecls = AST.nodeDecls mod
+            modInsts = AST.moduleInsts mod
+            concreteArgs = Map.map argumentValue args
+            modContext = moduleContext concreteArgs
+            nameSpaceId = identToName context nameSpace
+        declNet <- buildNet modContext nodeDecls
+        instNet <- buildNet modContext modInsts
+        let
+            prefixDeclNet = map (prefix nameSpaceId) declNet
+            prefixInstNet = map (prefix nameSpaceId) instNet
+        return $ prefixDeclNet ++ prefixInstNet
+        where
+            argumentValue (AST.AddressArg value) = value
+            argumentValue (AST.NumberArg value) = value
+            argumentValue (AST.ParamArg name) = getParamValue context name
+            moduleContext paramValues =
+                context
+                    { paramValues = paramValues
+                    , varValues = Map.empty
+                    }
+
+
+instance NetSource AST.Identifier NetAST.NodeId where
+    buildNet context ast = do
+        let
+            name = identToName context ast
+        return NetAST.NodeId
+            { NetAST.namespace = []
+            , NetAST.name      = name
+            }
+
+instance NetSource AST.NodeDecl NetList where
+    buildNet context (AST.MultiNodeDecl for) = buildNet context for
+    buildNet context ast = do
+        let
+            ident = AST.nodeId ast
+            nodeSpec = AST.nodeSpec ast
+        nodeId <- buildNet context ident
+        netNodeSpec <- buildNet context nodeSpec
+        return [(nodeId, netNodeSpec)]
+
+instance NetSource a NetList => NetSource [a] NetList where
+    buildNet context ast = do
+        let
+            decls = map (buildNet context) ast
+            fs = lefts decls
+            ds = rights decls
+        case fs of
+            [] -> return $ concat ds
+            _  -> Left $ CheckFailure (unlines $ map message fs)
+
+instance NetSource AST.NodeSpec NetAST.NodeSpec where
+    buildNet context ast = do
+        return NetAST.NodeSpec
+            { NetAST.nodeType  = NetAST.Other
+            , NetAST.accept    = []
+            , NetAST.translate = []
+            , NetAST.overlay   = Nothing
+            }
+
+instance NetSource a NetList => NetSource (AST.For a) NetList where
+    buildNet context ast = do
+        let
+            body = AST.body ast
+            varRanges = AST.varRanges ast
+            concreteRanges = Map.map concreteRange varRanges
+            valueList = Map.foldWithKey iterations [] concreteRanges
+            iterContexts = map iterationContext valueList
+            decls = map (\c -> buildNet c body) iterContexts
+            fs = lefts decls
+            ds = rights decls
+        case fs of
+            [] -> return $ concat ds
+            _  -> Left $ CheckFailure (unlines $ map message fs)
+        where
+            concreteRange range =
+                let
+                    start = limitVal $ AST.start range
+                    end = limitVal $ AST.end range
+                in [start..end]
+            limitVal (AST.NumberLimit value) = value
+            limitVal (AST.ParamLimit name) = getParamValue context name
+            iterations k vs [] = [Map.fromList [(k,v)] | v <- vs]
+            iterations k vs ms = concat $ map (f ms k) vs
+                where
+                    f ms k v = map (Map.insert k v) ms
+            iterationContext varMap =
+                let values = varValues context
+                in context
+                    { varValues = values `Map.union` varMap }
+
+getModule :: Context -> String -> AST.Module
+getModule context name =
+    let
+        modules = AST.modules $ spec context
+    in modules Map.! name
+
+getParamValue :: Context -> String -> Word
+getParamValue context name =
+    let
+        params = paramValues context
+    in params Map.! name
+
+getVarValue :: Context -> String -> Word
+getVarValue context name =
+    let
+        vars = varValues context
+    in vars Map.! name
+
+identToName :: Context -> AST.Identifier -> String
+identToName _ (AST.SimpleIdent name) = name
+identToName context ident =
+    let
+        prefix = AST.prefix ident
+        varName = AST.varName ident
+        suffix = AST.suffix ident
+        varValue = show $ getVarValue context varName
+        suffixName = case suffix of
+            Nothing -> ""
+            Just s  -> identToName context s
+    in prefix ++ varValue ++ suffixName
 
-instance NetSource AST.ModuleInst NetAST.NetSpec where
-    buildNet ast = Left $ CheckFailure "ModuleInst conversion not yet implemented"
\ No newline at end of file
+prefix :: String -> (NetAST.NodeId, NetAST.NodeSpec) -> (NetAST.NodeId, NetAST.NodeSpec)
+prefix nameSpace (nodeId, nodeSpec) =
+    let
+        prevNS = NetAST.namespace nodeId
+        prefixed = if nameSpace == ""
+            then nodeId
+            else nodeId
+                { NetAST.namespace = nameSpace:prevNS }
+    in (prefixed, nodeSpec)