Sockeye: Implement port mappings
authorDaniel Schwyn <schwyda@student.ethz.ch>
Fri, 14 Jul 2017 14:20:16 +0000 (16:20 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Fri, 14 Jul 2017 14:20:16 +0000 (16:20 +0200)
Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye/SockeyeAST.hs
tools/sockeye/SockeyeASTDecodingNet.hs
tools/sockeye/SockeyeASTParser.hs
tools/sockeye/SockeyeBackendProlog.hs
tools/sockeye/SockeyeChecker.hs
tools/sockeye/SockeyeNetBuilder.hs

index 066c45a..572ff32 100644 (file)
@@ -41,7 +41,8 @@ instance Show ModuleParamType where
     show AddressParam = "addr"
 
 data Port
-    = Port Identifier
+    = InputPort Identifier
+    | OutputPort Identifier
     | MultiPort (For Port)
     deriving (Show)
 
index 1a8a497..506666e 100644 (file)
@@ -39,7 +39,7 @@ newtype Namespace = Namespace
     deriving (Eq, Ord)
 
 instance Show Namespace where
-    show (Namespace ns) = intercalate "." ns
+    show (Namespace ns) = intercalate "." $ ns
 
 data NodeSpec
     = NodeSpec
@@ -48,7 +48,6 @@ data NodeSpec
         , translate :: [MapSpec]
         , overlay   :: Maybe NodeId
         }
-    | AliasSpec (Maybe NodeId)
     deriving (Show)
 
 data NodeType
index ee93b29..06de7f3 100644 (file)
@@ -56,10 +56,8 @@ data ModuleBody = ModuleBody
     } deriving (Show)
 
 data PortDef
-    = InputPortDef
-        { portId :: Identifier }
-    | OutputPortDef
-        { portId :: Identifier }
+    = InputPortDef Identifier
+    | OutputPortDef Identifier
     | MultiPortDef (For PortDef)
     deriving (Show)
 
index b6c4ebb..2da46cf 100644 (file)
@@ -25,65 +25,61 @@ import Numeric (showHex)
 import qualified SockeyeASTDecodingNet as AST
 
 compile :: AST.NetSpec -> String
-compile = fromJust . generate
+compile = generate
 
 {- Code Generator -}
 class PrologGenerator a where
-    generate :: a -> Maybe String
+    generate :: a -> String
 
 instance PrologGenerator AST.NetSpec where
-    generate (AST.NetSpec net) = do
-        let
-            mapped = Map.mapWithKey toFact net
-            facts = catMaybes $ Map.elems mapped
-        return $ unlines facts
+    generate (AST.NetSpec net) = let
+        mapped = Map.mapWithKey toFact net
+        facts = Map.elems mapped
+        in unlines facts
         where
-            toFact nodeId nodeSpec = do
-                atom <- generate nodeId
-                node <- generate nodeSpec
-                return $ predicate "net" [atom, node] ++ "."
+            toFact nodeId nodeSpec = let
+                atom = generate nodeId
+                node = generate nodeSpec
+                in predicate "net" [atom, node] ++ "."
 
 instance PrologGenerator AST.NodeId where
-    generate ast = do
-        return $ (atom $ show ast)
+    generate ast = atom $ show ast
 
 instance PrologGenerator AST.NodeSpec where
-    generate (AST.AliasSpec alias) = maybe Nothing generate alias
-    generate ast = do
-        nodeType <- generate $ AST.nodeType ast
-        accept <- generate $ AST.accept ast
-        translate <- generate $ AST.translate ast
-        overlay <- case AST.overlay ast of
-            Nothing -> return $ atom "@none"
+    generate ast = let
+        nodeType = generate $ AST.nodeType ast
+        accept = generate $ AST.accept ast
+        translate = generate $ AST.translate ast
+        overlay = case AST.overlay ast of
+            Nothing -> atom "@none"
             Just id -> generate id
-        return $ predicate "node" [nodeType, accept, translate, overlay]
+        in predicate "node" [nodeType, accept, translate, overlay]
 
 instance PrologGenerator AST.BlockSpec where
-    generate blockSpec = do
-        base  <- generate $ AST.base blockSpec
-        limit <- generate $ AST.limit blockSpec
-        return $ predicate "block" [base, limit]
+    generate blockSpec = let
+        base = generate $ AST.base blockSpec
+        limit = generate $ AST.limit blockSpec
+        in predicate "block" [base, limit]
 
 instance PrologGenerator AST.MapSpec where
-    generate mapSpec = do
-        src  <- generate $ AST.srcBlock mapSpec
-        dest <- generate $ AST.destNode mapSpec
-        base <- generate $ AST.destBase mapSpec
-        return $ predicate "map" [src, dest, base]
+    generate mapSpec = let
+        src  = generate $ AST.srcBlock mapSpec
+        dest = generate $ AST.destNode mapSpec
+        base = generate $ AST.destBase mapSpec
+        in predicate "map" [src, dest, base]
 
 instance PrologGenerator AST.NodeType where
-    generate AST.Memory = return $ atom "memory"
-    generate AST.Device = return $ atom "device"
-    generate AST.Other  = return $ atom "other"
+    generate AST.Memory = atom "memory"
+    generate AST.Device = atom "device"
+    generate AST.Other  = atom "other"
 
 instance PrologGenerator AST.Address where
-    generate (AST.Address addr) = return $ "16'" ++ showHex addr ""
+    generate (AST.Address addr) = "16'" ++ showHex addr ""
 
 instance PrologGenerator a => PrologGenerator [a] where
-    generate ast = do
-        let
-            mapped = map generate ast
-        return $ (list . catMaybes) mapped
+    generate ast = let
+        mapped = map generate ast
+        in list mapped
 
 {- Helper functions -}
 atom :: String -> String
index 78e9557..05a4e2f 100644 (file)
@@ -44,8 +44,8 @@ data FailedCheckType
     | NoSuchParameter String
     | NoSuchVariable String
     | ParamTypeMismatch String AST.ModuleParamType AST.ModuleParamType
-    | WrongNumberOfArgs Int Int
-    | ArgTypeMismatch String AST.ModuleParamType AST.ModuleParamType
+    | WrongNumberOfArgs String Int Int
+    | ArgTypeMismatch String String AST.ModuleParamType AST.ModuleParamType
 
 instance Show FailedCheckType where
     show (DuplicateModule name)          = concat ["Multiple definitions for module '", name, "'"]
@@ -54,15 +54,15 @@ instance Show FailedCheckType where
     show (NoSuchModule name)             = concat ["No definition for module '", name, "'"]
     show (NoSuchParameter name)          = concat ["Parameter '", name, "' not in scope"]
     show (NoSuchVariable name)           = concat ["Variable '", name, "' not in scope"]
-    show (WrongNumberOfArgs takes given) =
+    show (WrongNumberOfArgs name takes given) =
         let arg = if takes == 1
             then "argument"
             else "arguments"
-        in concat ["Module takes ", show takes, " ", arg, ", given ", show given]
+        in concat ["Module '", name, "' takes ", show takes, " ", arg, ", given ", show given]
     show (ParamTypeMismatch name expected actual) =
         concat ["Expected type '", show expected, "' but '", name, "' has type '", show actual, "'"]
-    show (ArgTypeMismatch name expected actual) =
-        concat ["Type mismatch for argument '", name, "': Expected '", show expected, "', given '", show actual, "'"]
+    show (ArgTypeMismatch modName name expected actual) =
+        concat ["Type mismatch for argument '", name, "' for module '", modName, "': Expected '", show expected, "', given '", show actual, "'"]
 
 data FailedCheck = FailedCheck
     { failure  :: FailedCheckType
@@ -82,7 +82,7 @@ instance Show CheckFailure where
                 let
                     title = "\nIn module '" ++ name ++ "':"
                     fails = filter (\f -> name == inModule f) fs
-                in if name == ""
+                in if name == "@root"
                     then "":showFails 0 fails
                     else title:showFails 1 fails
             showFails indentLevel fs =
@@ -203,12 +203,15 @@ instance Checkable ParseAST.Module AST.Module where
             isOutPort = not . isInPort
 
 instance Checkable ParseAST.PortDef AST.Port where
+    check context (ParseAST.InputPortDef ident) = do
+        checkedId <- check context ident
+        return $ AST.InputPort checkedId
+    check context (ParseAST.OutputPortDef ident) = do
+        checkedId <- check context ident
+        return $ AST.OutputPort checkedId
     check context (ParseAST.MultiPortDef for) = do
         checkedFor <- check context for
         return $ AST.MultiPort checkedFor
-    check context portDef = do
-        checkedId <- check context (ParseAST.portId portDef)
-        return $ AST.Port checkedId
 
 instance Checkable ParseAST.NetSpec (Either AST.NodeDecl AST.ModuleInst) where
     check context (ParseAST.NodeDeclSpec decl) = do
@@ -267,7 +270,7 @@ instance Checkable ParseAST.ModuleInst AST.ModuleInst where
                             argc = length args
                         if argc == paramc
                             then return ()
-                            else Left $ checkFailure context [WrongNumberOfArgs paramc argc]
+                            else Left $ checkFailure context [WrongNumberOfArgs (instModule context) paramc argc]
                     checkArgType (name, expected) arg = do
                         case arg of
                             ParseAST.AddressArg value -> do
@@ -282,7 +285,7 @@ instance Checkable ParseAST.ModuleInst AST.ModuleInst where
                                 checkParamType context pName expected
                                 return $ AST.ParamArg pName
                         where
-                            mismatch t = checkFailure context [ArgTypeMismatch name expected t]
+                            mismatch t = checkFailure context [ArgTypeMismatch (instModule context) name expected t]
 
 instance Checkable ParseAST.PortMap AST.PortMap where
     check context (ParseAST.MultiPortMap for) = do
index be504c5..f8008f5 100644 (file)
@@ -26,7 +26,7 @@ import Data.Either
 import Data.List (nub, intercalate)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe (fromMaybe, maybe)
+import Data.Maybe (catMaybes, fromMaybe, maybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
 
@@ -41,23 +41,27 @@ import Debug.Trace
 type NetNodeDecl = (NetAST.NodeId, NetAST.NodeSpec)
 type NetList = [NetNodeDecl]
 type PortList = [NetAST.NodeId]
-type PortMap = [(NetAST.NodeId, NetAST.NodeId)]
+type PortMap = [(String, NetAST.NodeId)]
 
 data FailedCheck
     = ModuleInstLoop [String]
-    | DuplicateInPort String NetAST.NodeId
-    | UndefinedInPort String NetAST.NodeId
-    | DuplicateOutPort String NetAST.NodeId
-    | UndefinedOutPort String NetAST.NodeId
-    | DuplicateIdentifer NetAST.NodeId
-    | UndefinedReference NetAST.NodeId
+    | DuplicateInPort !String !String
+    | DuplicateInMap !String !String
+    | UndefinedInPort !String !String
+    | DuplicateOutPort !String !String
+    | DuplicateOutMap !String !String
+    | UndefinedOutPort !String !String
+    | DuplicateIdentifer !String
+    | UndefinedReference !String
 
 instance Show FailedCheck where
-    show (ModuleInstLoop loop) = concat ["Module instantiation loop :'", intercalate "' -> '" $ loop, "'"]
-    show (DuplicateInPort  modName ident) = concat ["Multiple declarations of input port '", NetAST.name ident, "' in '", modName, "'"]
-    show (UndefinedInPort  modName ident) = concat ["'", NetAST.name ident, "' is not an input port in '", modName, "'"]
-    show (DuplicateOutPort modName ident) = concat ["Multiple declarations of output port '", NetAST.name ident, "' in '", modName, "'"]
-    show (UndefinedOutPort modName ident) = concat ["'", NetAST.name ident, "' is not an output port in '", modName, "'"]
+    show (ModuleInstLoop loop) = concat ["Module instantiation loop :'", intercalate "' -> '" loop, "'"]
+    show (DuplicateInPort  modName port) = concat ["Multiple declarations of input port '", port, "' in '", modName, "'"]
+    show (DuplicateInMap   ns      port) = concat ["Multiple mappings for input port '", port, "' in '", ns, "'"]
+    show (UndefinedInPort  modName port) = concat ["'", port, "' is not an input port in '", modName, "'"]
+    show (DuplicateOutPort modName port) = concat ["Multiple declarations of output port '", port, "' in '", modName, "'"]
+    show (DuplicateOutMap   ns      port) = concat ["Multiple mappings for output port '", port, "' in '", ns, "'"]
+    show (UndefinedOutPort modName port) = concat ["'", port, "' is not an output port in '", modName, "'"]
     show (DuplicateIdentifer ident)   = concat ["Multiple declarations of node '", show ident, "'"]
     show (UndefinedReference ident)   = concat ["Reference to undefined node '", show ident, "'"]
 
@@ -73,6 +77,8 @@ data Context = Context
     , curNamespace :: NetAST.Namespace
     , paramValues  :: Map String Word
     , varValues    :: Map String Word
+    , inPortMaps   :: Map String NetAST.NodeId
+    , outPortMaps  :: Map String NetAST.NodeId
     }
 
 sockeyeBuildNet :: AST.SockeyeSpec -> Either CheckFailure NetAST.NetSpec
@@ -84,6 +90,8 @@ sockeyeBuildNet ast = do
             , curNamespace = NetAST.Namespace []
             , paramValues  = Map.empty
             , varValues    = Map.empty
+            , inPortMaps   = Map.empty
+            , outPortMaps  = Map.empty
             }        
     net <- transform context ast
     trace (groom net) $ return ()
@@ -122,12 +130,66 @@ instance NetTransformable AST.Module NetList where
             outPorts = AST.outputPorts ast
             nodeDecls = AST.nodeDecls ast
             moduleInsts = AST.moduleInsts ast
-            name = last $ modulePath context
-        -- checkDuplicates inPorts $ DuplicateInPort name
-        -- checkDuplicates outPorts $ DuplicateOutPort name
+        inDecls <- do
+            net <- transform context inPorts
+            return $ concat (net :: [NetList])
+        outDecls <- do
+            net <- transform context outPorts
+            return $ concat (net :: [NetList])
+        -- TODO check duplicate ports
+        -- TODO check mappings to non existing port
         netDecls <- transform context nodeDecls
         netInsts <- transform context moduleInsts
-        return $ concat (netDecls ++ netInsts :: [NetList])
+        return $ concat (inDecls:outDecls:netDecls ++ netInsts)
+        where
+            nameWithArgs =
+                let
+                    name = head $ modulePath context
+                    paramNames = AST.paramNames ast
+                    paramTypes = AST.paramTypeMap ast
+                    params = map (\p -> (p, paramTypes Map.! p)) paramNames
+                    argValues = map showValue params
+                in concat [name, "(", intercalate ", " argValues, ")"]
+                where
+                    showValue (name, AST.AddressParam) = "0x" ++ showHex (getParamValue context name) ""
+                    showValue (name, AST.NaturalParam) = show (getParamValue context name)
+            
+
+instance NetTransformable AST.Port NetList where
+    transform context (AST.MultiPort for) = do
+        netPorts <- transform context for
+        return $ concat (netPorts :: [NetList])
+    transform context (AST.InputPort ident) = do
+        netIdent <- transform context ident
+        let
+            portMap = inPortMaps context
+            decl = mapPort portMap netIdent
+        return $ catMaybes [decl]
+            where
+                mapPort portMap port = do
+                    let
+                        name = NetAST.name port
+                    mappedId <- Map.lookup name portMap
+                    return (mappedId, portMapTemplate { NetAST.overlay = Just port })
+    transform context (AST.OutputPort ident) = do
+        netIdent <- transform context ident
+        let
+            portMap = outPortMaps context
+            decl = mapPort portMap netIdent
+        return [decl]
+            where
+                mapPort portMap port = let
+                    name = NetAST.name port
+                    mappedId = Map.lookup name portMap
+                    in (port, portMapTemplate { NetAST.overlay = mappedId })
+
+portMapTemplate :: NetAST.NodeSpec
+portMapTemplate = NetAST.NodeSpec
+    { NetAST.nodeType  = NetAST.Other
+    , NetAST.accept    = []
+    , NetAST.translate = []
+    , NetAST.overlay   = Nothing
+    }
 
 instance NetTransformable AST.ModuleInst NetList where
     transform context (AST.MultiModuleInst for) = do
@@ -144,22 +206,31 @@ instance NetTransformable AST.ModuleInst NetList where
         checkSelfInst name
         netNamespace <- transform context namespace
         netArgs <- transform context args
+        netInMap <- transform context inPortMap
+        netOutMap <- transform context outPortMap
+        let
+            inMaps = concat (netInMap :: [PortMap])
+            outMaps = concat (netOutMap :: [PortMap])
+        checkDuplicates (map fst inMaps) (DuplicateInMap $ show netNamespace) 
+        checkDuplicates (map fst outMaps) (DuplicateOutMap $ show netNamespace)
         let
-            modContext = moduleContext name netNamespace netArgs
+            modContext = moduleContext name netNamespace netArgs inMaps outMaps
         transform modContext mod
             where
-                moduleContext name namespace args =
+                moduleContext name namespace args inMaps outMaps =
                     let
                         path = modulePath context
                         base = NetAST.ns $ NetAST.namespace namespace
                         newNs = case NetAST.name namespace of
                             "" -> NetAST.Namespace base
-                            n  -> NetAST.Namespace $ n:base
+                            n  -> NetAST.Namespace $ base ++ [n]
                     in context
                         { modulePath   = name:path
                         , curNamespace = newNs
                         , paramValues  = args
                         , varValues    = Map.empty
+                        , inPortMaps   = Map.fromList inMaps
+                        , outPortMaps  = Map.fromList outMaps
                         }
                 checkSelfInst name = do
                     let
@@ -184,7 +255,7 @@ instance NetTransformable AST.PortMap PortMap where
             mappedPort = AST.mappedPort ast
         netMappedId <- transform context mappedId
         netMappedPort <- transform context mappedPort
-        return [(netMappedId, netMappedPort)]
+        return [(NetAST.name netMappedPort, netMappedId)]
 
 instance NetTransformable AST.ModuleArg Word where
     transform context (AST.AddressArg value) = return value
@@ -369,10 +440,6 @@ instance NetCheckable NetAST.NetSpec where
         check specContext $ Map.elems net
 
 instance NetCheckable NetAST.NodeSpec where
-    check context (NetAST.AliasSpec alias) = do
-        case alias of
-            Nothing -> return ()
-            Just ident -> check context ident
     check context net = do
         let
             translate = NetAST.translate net
@@ -390,7 +457,7 @@ instance NetCheckable NetAST.NodeId where
     check context net = do
         if net `Set.member` context
             then return ()
-            else Left $ CheckFailure [UndefinedReference net]
+            else Left $ CheckFailure [UndefinedReference $ show net]
 
 instance NetCheckable a => NetCheckable [a] where
     check context net = do
@@ -419,13 +486,13 @@ getVarValue context name =
         vars = varValues context
     in vars Map.! name
 
-checkDuplicates :: [NetAST.NodeId] -> (NetAST.NodeId -> FailedCheck) -> Either CheckFailure ()
+checkDuplicates :: (Eq a, Show a) => [a] -> (String -> FailedCheck) -> Either CheckFailure ()
 checkDuplicates nodeIds fail = do
     let
         duplicates = duplicateNames nodeIds
     case duplicates of
         [] -> return ()
-        _  -> Left $ CheckFailure (map fail duplicates)
+        _  -> Left $ CheckFailure (map (fail . show) duplicates)
     where
         duplicateNames [] = []
         duplicateNames (x:xs)