Sockeye: Start implementing overley to map translation
authorDaniel Schwyn <schwyda@student.ethz.ch>
Tue, 18 Jul 2017 16:18:23 +0000 (18:18 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Tue, 18 Jul 2017 16:18:23 +0000 (18:18 +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
tools/sockeye/SockeyeParser.hs

index 572ff32..bf7b359 100644 (file)
@@ -41,8 +41,14 @@ instance Show ModuleParamType where
     show AddressParam = "addr"
 
 data Port
-    = InputPort Identifier
-    | OutputPort Identifier
+    = InputPort 
+        { portId    :: Identifier
+        , portWidth :: !Word
+        }
+    | OutputPort
+        { portId    :: Identifier
+        , portWidth :: !Word
+        }
     | MultiPort (For Port)
     deriving (Show)
 
@@ -92,7 +98,7 @@ data NodeSpec = NodeSpec
     { nodeType  :: Maybe NodeType
     , accept    :: [BlockSpec]
     , translate :: [MapSpec]
-    , overlay   :: Maybe Identifier
+    , overlay   :: Maybe OverlaySpec
     } deriving (Show)
 
 data NodeType
@@ -120,6 +126,12 @@ data MapSpec
         , destBase :: Maybe Address
         } deriving (Show)
 
+data OverlaySpec
+    = OverlaySpec
+        { over  :: Identifier
+        , width :: !Word
+        } deriving (Show)
+
 data Address
     = LiteralAddress !Word
     | ParamAddress !String
index 743eab7..11d2bee 100644 (file)
@@ -46,7 +46,6 @@ data NodeSpec
         { nodeType  :: NodeType
         , accept    :: [BlockSpec]
         , translate :: [MapSpec]
-        , overlay   :: Maybe NodeId
         }
     deriving (Show)
 
index e74c9bf..9cf4c21 100644 (file)
@@ -29,6 +29,8 @@ import SockeyeAST
     , BlockSpec(SingletonBlock, RangeBlock, LengthBlock)
     , base, limit, bits
     , MapSpec(MapSpec)
+    , OverlaySpec(OverlaySpec)
+    , over, width
     , block, destNode, destBase
     , Address(LiteralAddress, ParamAddress)
     , ForLimit(LiteralLimit, ParamLimit)
@@ -62,8 +64,14 @@ data ModuleBody = ModuleBody
     } deriving (Show)
 
 data PortDef
-    = InputPortDef Identifier
-    | OutputPortDef Identifier
+    = InputPortDef
+        { portId    :: Identifier
+        , portWidth :: !Word
+        }
+    | OutputPortDef
+        { portId    :: Identifier
+        , portWidth :: !Word
+        }
     | MultiPortDef (For PortDef)
     deriving (Show)
 
index 7416b6b..e78333c 100644 (file)
@@ -58,10 +58,7 @@ instance PrologGenerator AST.NodeSpec where
         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
-        in predicate "node" [nodeType, accept, translate, overlay]
+        in predicate "node" [nodeType, accept, translate]
 
 instance PrologGenerator AST.BlockSpec where
     generate blockSpec = let
index 05a4e2f..96f1f58 100644 (file)
@@ -197,18 +197,18 @@ instance Checkable ParseAST.Module AST.Module where
             , AST.moduleInsts = checkedModuleInsts
             }
         where
-            isInPort (ParseAST.InputPortDef _) = True
+            isInPort (ParseAST.InputPortDef _ _) = True
             isInPort (ParseAST.MultiPortDef for) = isInPort $ ParseAST.body for
             isInPort _ = False
             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.InputPortDef portId portWidth) = do
+        checkedId <- check context portId
+        return $ AST.InputPort checkedId portWidth
+    check context (ParseAST.OutputPortDef portId portWidth) = do
+        checkedId <- check context portId
+        return $ AST.OutputPort checkedId portWidth
     check context (ParseAST.MultiPortDef for) = do
         checkedFor <- check context for
         return $ AST.MultiPort checkedFor
@@ -393,6 +393,11 @@ instance Checkable ParseAST.MapSpec AST.MapSpec where
             , AST.destBase = checkedDestBase
             }
 
+instance Checkable ParseAST.OverlaySpec AST.OverlaySpec where
+    check context (ParseAST.OverlaySpec over width) = do
+        checkedOver <- check context over
+        return $ AST.OverlaySpec checkedOver width
+
 instance Checkable ParseAST.Address AST.Address where
     check _ (ParseAST.LiteralAddress value) = do
         return $ AST.LiteralAddress value
index 95d6b3d..3edd83a 100644 (file)
@@ -23,7 +23,7 @@ module SockeyeNetBuilder
 import Control.Monad.State
 
 import Data.Either
-import Data.List (nub, intercalate)
+import Data.List (nub, intercalate, sort)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes, fromMaybe, maybe)
@@ -76,6 +76,7 @@ data Context = Context
     , varValues    :: Map String Word
     , inPortMaps   :: Map String NetAST.NodeId
     , outPortMaps  :: Map String NetAST.NodeId
+    , mappedBlocks :: [NetAST.BlockSpec]
     }
 
 sockeyeBuildNet :: AST.SockeyeSpec -> Either CheckFailure NetAST.NetSpec
@@ -89,6 +90,7 @@ sockeyeBuildNet ast = do
             , varValues    = Map.empty
             , inPortMaps   = Map.empty
             , outPortMaps  = Map.empty
+            , mappedBlocks = []
             }        
     net <- transform context ast
     check Set.empty net
@@ -142,37 +144,53 @@ 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
+    transform context (AST.InputPort portId portWidth) = do
+        netPortId <- transform context portId
         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
+            name = NetAST.name netPortId
+            mappedId = Map.lookup name portMap
+        case mappedId of
+            Nothing    -> return []
+            Just ident -> do
+                let
+                    node = portNode netPortId portWidth
+                return [(ident, node)]
+    transform context (AST.OutputPort portId portWidth) = do
+        netPortId <- transform context portId
         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 })
+            name = NetAST.name netPortId
+            mappedId = Map.lookup name portMap
+        case mappedId of
+            Nothing    -> return [(netPortId, portNodeTemplate)]
+            Just ident -> do
+                let
+                    node = portNode ident portWidth
+                return [(netPortId, node)]
+
+portNode :: NetAST.NodeId -> Word -> NetAST.NodeSpec
+portNode destNode width =
+    let
+        base = NetAST.Address 0
+        limit = NetAST.Address $ 2^width - 1
+        srcBlock = NetAST.BlockSpec
+            { NetAST.base  = base
+            , NetAST.limit = limit
+            }
+        map = NetAST.MapSpec
+                { NetAST.srcBlock = srcBlock
+                , NetAST.destNode = destNode
+                , NetAST.destBase = base
+                }
+    in portNodeTemplate { NetAST.translate = [map] }
 
-portMapTemplate :: NetAST.NodeSpec
-portMapTemplate = NetAST.NodeSpec
+portNodeTemplate :: NetAST.NodeSpec
+portNodeTemplate = 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
@@ -289,16 +307,17 @@ instance NetTransformable AST.NodeSpec NetAST.NodeSpec where
         netNodeType <- maybe (return NetAST.Other) (transform context) nodeType
         netAccept <- transform context accept
         netTranslate <- transform context translate
+        let
+            mapBlocks = map NetAST.srcBlock netTranslate
+            nodeContext = context
+                { mappedBlocks = netAccept ++ mapBlocks }
         netOverlay <- case overlay of
-                Nothing -> return Nothing
-                Just o  -> do 
-                    t <- transform context o
-                    return $ Just t
+                Nothing -> return []
+                Just o  -> transform nodeContext o
         return NetAST.NodeSpec
             { NetAST.nodeType  = netNodeType
             , NetAST.accept    = netAccept
-            , NetAST.translate = netTranslate
-            , NetAST.overlay   = netOverlay
+            , NetAST.translate = netTranslate ++ netOverlay
             }
 
 instance NetTransformable AST.NodeType NetAST.NodeType where
@@ -345,6 +364,52 @@ instance NetTransformable AST.MapSpec NetAST.MapSpec where
             , NetAST.destBase = netDestBase
             }
 
+instance NetTransformable AST.OverlaySpec [NetAST.MapSpec] where
+    transform context ast = do
+        let
+            over = AST.over ast
+            width = AST.width ast
+            blocks = mappedBlocks context
+            blockPoints = concat $ map toScanPoints blocks
+            overStart = BlockEnd 0
+            overStop  = BlockStart $ 2^width
+            scanPoints = overStart:overStop:blockPoints
+        netOver <- transform context over
+        return $ overlayMaps netOver scanPoints
+        where
+            toScanPoints (NetAST.BlockSpec base limit) =
+                [ BlockStart $ NetAST.address base
+                , BlockEnd   $ NetAST.address limit
+                ]
+
+overlayMaps :: NetAST.NodeId -> [ScanPoint] -> [NetAST.MapSpec]
+overlayMaps destId scanPoints =
+    let
+        sorted = sort scanPoints
+    in foldl pointAction [] scanPoints
+    where
+        pointAction _ _ = []
+
+data ScanPoint
+    = BlockStart { address :: !Word }
+    | BlockEnd   { address :: !Word }
+    deriving (Eq, Show)
+
+instance Ord ScanPoint where
+    (<=) (BlockStart a1) (BlockEnd   a2)
+        | a1 == a2 = True
+        | otherwise = a1 <= a2
+    (<=) (BlockEnd   a1) (BlockStart a2)
+        | a1 == a2 = False
+        | otherwise = a1 <= a2
+    (<=) sp1 sp2 = (address sp1) <= (address sp2)
+
+data ScanLineState
+    = ScanLineState
+        { insideBlocks   :: !Word
+        , lastEndAddress :: Maybe Word
+        }
+
 instance NetTransformable AST.Address NetAST.Address where
     transform _ (AST.LiteralAddress value) = do
         return $ NetAST.Address value
@@ -426,9 +491,7 @@ instance NetCheckable NetAST.NodeSpec where
     check context net = do
         let
             translate = NetAST.translate net
-            overlay = NetAST.overlay net
         check context translate
-        maybe (return ()) (check context) overlay
 
 instance NetCheckable NetAST.MapSpec where
     check context net = do
index 78bd0fc..7411e6a 100644 (file)
@@ -80,35 +80,39 @@ moduleParam = do
             return AST.AddressParam
 
 moduleBody = do
-    ports <- many $ portDef
+    ports <- many portDefs
     net <- many netSpecs
     return AST.ModuleBody
         { AST.ports     = concat ports
         , AST.moduleNet = concat net
         }
 
-portDef = choice [inputPorts, outputPorts]
+portDefs = choice [inputPorts, outputPorts]
     where
         inputPorts = do
             reserved "input"
-            ports <- commaSep1 identifierFor
-            return $ map toInDef ports
-        toInDef (forFn, iden) =
+            commaSep1 inDef
+        inDef = do
+            (forFn, portId) <- identifierFor
+            symbol "/"
+            portWidth <- decimal <?> "number of bits"
             let
-                portDef = AST.InputPortDef iden
-            in case forFn of
-                Nothing -> portDef
-                Just f  -> AST.MultiPortDef $ f portDef
+                portDef = AST.InputPortDef portId $ fromIntegral portWidth
+            case forFn of
+                Nothing -> return portDef
+                Just f  -> return $ AST.MultiPortDef (f portDef)
         outputPorts = do
             reserved "output"
-            ports <- commaSep1 identifierFor
-            return $ map toOutDef ports
-        toOutDef (forFn, iden) =
+            commaSep1 outDef
+        outDef = do
+            (forFn, portId) <- identifierFor
+            symbol "/"
+            portWidth <- decimal <?> "number of bits"
             let
-                portDef = AST.OutputPortDef iden
-            in case forFn of
-            Nothing -> portDef
-            Just f  -> AST.MultiPortDef $ f portDef
+                portDef = AST.OutputPortDef portId $ fromIntegral portWidth
+            case forFn of
+                Nothing -> return portDef
+                Just f  -> return $ AST.MultiPortDef (f portDef)
 
 netSpecs = choice [ inst <?> "module instantiation"
                  , decl <?> "node declaration"
@@ -222,9 +226,6 @@ nodeSpec = do
             reserved "map"
             specs <- brackets $ many mapSpecs
             return $ concat specs
-        overlay = do
-            reserved "over"
-            identifier
 
 nodeType = choice [memory, device]
     where memory = do
@@ -273,6 +274,16 @@ mapSpecs = do
             , AST.destBase = destBase
             }
 
+overlay = do
+    reserved "over"
+    over <- identifier
+    symbol "/"
+    width <- decimal <?> "number of bits"
+    return AST.OverlaySpec
+        { AST.over  = over
+        , AST.width = fromIntegral width
+        }
+
 identifierFor = identifierHelper True
 
 forVarRange optVarName