Sockeye: Start implementation of checker
authorDaniel Schwyn <schwyda@student.ethz.ch>
Thu, 6 Jul 2017 09:17:37 +0000 (11:17 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Thu, 6 Jul 2017 09:18:36 +0000 (11:18 +0200)
Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye/Main.hs
tools/sockeye/SockeyeASTFrontend.hs
tools/sockeye/SockeyeASTIntermediate.hs [new file with mode: 0644]
tools/sockeye/SockeyeChecker.hs
tools/sockeye/SockeyeParser.hs

index 5ba3078..7846418 100644 (file)
 module Main where
 
 import Control.Monad
+
 import Data.List
+
 import System.Console.GetOpt
 import System.Exit
 import System.Environment
 import System.IO
 
-import SockeyeASTFrontend as AST1
-import SockeyeASTBackend as AST2
+import SockeyeASTFrontend as ASTF
+import SockeyeASTIntermediate as ASTI
+import SockeyeASTBackend as ASTB
 
 import SockeyeParser
 import SockeyeChecker
 import qualified SockeyeBackendPrintAST as PrintAST
 import qualified SockeyeBackendProlog as Prolog
 
+import Text.Groom(groom)
+
+{- Exit codes -}
+usageError :: ExitCode
+usageError = ExitFailure 1
+
+parseError :: ExitCode
+parseError = ExitFailure 2
+
+checkError :: ExitCode
+checkError = ExitFailure 3
+
+
+
 {- Compilation targets -}
 data Target = None | PrintAST | Prolog
 
@@ -93,43 +110,41 @@ compilerOpts argv =
     case getOpt Permute options argv of
         (actions, fs, []) -> do
             opts <- foldl (>>=) (return defaultOptions) actions
-            case fs of []  -> do
-                                usage ["No input file\n"]
-                                exitWith $ ExitFailure 1
-                       [f] -> return $ optSetInputFileName f opts
-                       _   -> do
-                                usage ["Multiple input files not supported\n"]
-                                exitWith $ ExitFailure 1
+            case fs of
+                []  -> do
+                    usage ["No input file\n"]
+                    exitWith usageError
+                [f] -> return $ optSetInputFileName f opts
+                _   -> do
+                    usage ["Multiple input files not supported\n"]
+                    exitWith usageError
 
         (_, _, errors) -> do
             usage errors
-            exitWith $ ExitFailure 1
+            exitWith $ usageError
 
 {- Runs the parser -}
-parseFile :: FilePath -> IO (AST1.SockeyeSpec)
+parseFile :: FilePath -> IO (ASTF.SockeyeSpec)
 parseFile file = do
     src <- readFile file
     case parseSockeye file src of
         Left err -> do
             hPutStrLn stderr $ "Parse error at " ++ show err
-            exitWith $ ExitFailure 2
+            exitWith parseError
         Right ast -> return ast
 
 {- Runs the checker -}
-checkAST :: AST2.NetSpec -> IO ()
-checkAST ast = do
-    case checkSockeye ast of 
-        [] -> return ()
-        errors -> do
-            hPutStr stderr $ unlines (foldl flattenErrors ["Failed checks:"] errors)
-            exitWith $ ExitFailure 3
-        where flattenErrors es (key, errors)
-                = let indented = map ((replicate 4 ' ') ++) errors
-                  in es ++ case key of Nothing     -> errors
-                                       Just nodeId -> ("In specification of node '" ++ show nodeId ++ "':"):indented
+checkAST :: ASTF.SockeyeSpec -> IO ASTI.SockeyeSpec
+checkAST parsedAst = do
+    case checkSockeye parsedAst of 
+        Left fail -> do
+            hPutStrLn stderr $ "Checks failed:"
+            hPutStr stderr $ show fail
+            exitWith checkError
+        Right intermAst -> return intermAst
 
 {- Compiles the AST with the appropriate backend -}
-compile :: Target -> AST2.NetSpec -> IO String
+compile :: Target -> ASTB.NetSpec -> IO String
 compile None     _   = return ""
 compile PrintAST ast = return $ PrintAST.compile ast
 compile Prolog   ast = return $ Prolog.compile ast
@@ -137,16 +152,17 @@ compile Prolog   ast = return $ Prolog.compile ast
 {- Outputs the compilation result -}
 output :: Maybe FilePath -> String -> IO ()
 output outFile out = do
-    case outFile of Nothing -> putStr out
-                    Just f  -> writeFile f out
+    case outFile of
+        Nothing -> putStr out
+        Just f  -> writeFile f out
 
 main = do
     args <- getArgs
     opts <- compilerOpts args
     let inFile = optInputFile opts
-    ast <- parseFile inFile
-    print ast
-    -- checkAST ast
+    parsedAst <- parseFile inFile
+    intermAst <- checkAST parsedAst
+    putStrLn $ groom intermAst
     -- out <- compile (optTarget opts) ast
     -- output (optOutputFile opts) out
     
\ No newline at end of file
index f73c63b..023a12c 100644 (file)
@@ -21,9 +21,9 @@ data SockeyeSpec = SockeyeSpec
     } deriving (Show)
 
 data Module = Module
-    { name  :: String
-    , parameters  :: [ModuleParam]
-    , moduleBody  :: ModuleBody
+    { name       :: String
+    , parameters :: [ModuleParam]
+    , moduleBody :: ModuleBody
     } deriving (Show)
 
 data ModuleParam = ModuleParam
@@ -50,7 +50,6 @@ data PortDef
 data NetSpec
     = NodeDeclSpec [NodeDecl]
     | ModuleInstSpec ModuleInst
-    | MultiNetSpec (For [NetSpec])
     deriving (Show)
 
 data ModuleInst
@@ -146,7 +145,7 @@ data MapDest
 data For a 
     = For
         { varRanges :: [ForVarRange]
-        , body     :: a
+        , body      :: a
         } deriving (Show)
 
 data ForVarRange
diff --git a/tools/sockeye/SockeyeASTIntermediate.hs b/tools/sockeye/SockeyeASTIntermediate.hs
new file mode 100644 (file)
index 0000000..bca1cad
--- /dev/null
@@ -0,0 +1,105 @@
+{-
+  SockeyeASTIntermediate.hs: Intermediate 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 SockeyeASTIntermediate
+    ( module SockeyeASTIntermediate
+    , module SockeyeASTFrontend
+    ) where
+
+import Data.Map (Map)
+import Data.Set (Set)
+
+import SockeyeASTFrontend
+    ( Identifier(SimpleIdent,TemplateIdent)
+    , prefix, varName, suffix
+    , ModuleParamType(NumberParam,AddressParam)
+    , NodeType(Memory,Device)
+    , ForLimit(NumberLimit,ParamLimit)
+    )
+
+newtype SockeyeSpec = SockeyeSpec
+    { modules :: Map String Module }
+    deriving (Show)
+
+data Module = Module
+    { paramNames  :: [String]
+    , paramTypes  :: Map String ModuleParamType
+    , inputPorts  :: [Port]
+    , outputPorts :: [Port]
+    , nodeDecls   :: [NodeDecl]
+    , moduleInsts :: [ModuleInst]
+    } deriving (Show)
+
+data Port
+    = Port Identifier
+    | MultiPort (For Port)
+    deriving (Show)
+
+data ModuleInst
+    = ModuleInst
+        { nameSpace     :: Identifier
+        , moduleName    :: String
+        , arguments     :: Map String Word
+        , inputPortMap  :: [PortMap]
+        , outputPortMap :: [PortMap]
+        }
+    | MultiModuleInst (For ModuleInst)
+    deriving (Show)
+
+data PortMap
+    = PortMap
+        { mappedId :: Identifier
+        , portId   :: Identifier
+        }
+    | MultiPortMap (For PortMap)
+    deriving (Show)
+
+data NodeDecl
+    = NodeDecl
+        { nodeId   :: Identifier
+        , nodeSpec :: NodeSpec
+        }
+    | MultiNodeDecl (For NodeDecl)
+    deriving (Show)
+
+data NodeSpec = NodeSpec
+    { nodeType  :: Maybe NodeType
+    , accept    :: [BlockSpec]
+    , translate :: [MapSpec]
+    , overlay   :: Maybe String
+    } deriving (Show)
+
+data BlockSpec = BlockSpec
+    { base  :: !Word
+    , limit :: !Word
+    } deriving (Show)
+
+data MapSpec = MapSpec
+    { block    :: BlockSpec
+    , destNode :: !String
+    , destBase :: !Word
+    } deriving (Show)
+
+data For a 
+    = For
+        { varRanges :: Map String ForRange
+        , body      :: a
+        } deriving (Show)
+
+data ForRange
+    = ForRange
+    { start :: ForLimit
+    , end   :: ForLimit
+    } deriving (Show)
index 5a51ed0..523c3c7 100644 (file)
 {-
-  SockeyeChecker.hs: AST checker for Sockeye
+    SockeyeChecker.hs: AST checker for Sockeye
 
-  Part of Sockeye
+    Part of Sockeye
 
-  Copyright (c) 2017, ETH Zurich.
+    Copyright (c) 2017, ETH Zurich.
 
-  All rights reserved.
+    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.
+    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.
 -}
 
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 module SockeyeChecker
 ( checkSockeye ) where
 
-import Control.Monad
-import Control.Monad.Trans.Writer
+import Control.Monad (join)
 
+import Data.List (nub)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Char (toLower)
-
-import qualified SockeyeASTBackend as AST
-
-type CheckFailure = (Maybe AST.NodeId, String)
-
-canonicalId :: AST.NodeId -> AST.NodeId
-canonicalId = id
-
-findUniqueIdentifiers :: AST.NetSpec -> Writer [CheckFailure] (Set AST.NodeId)
-findUniqueIdentifiers (AST.NetSpec nodes) = let allIds = map fst $ nodes
-                                            in foldl checkAndAdd (return Set.empty) allIds
-                                            where checkAndAdd w id = do
-                                                    let cId = canonicalId id
-                                                    uids <- w
-                                                    tell $ if cId `Set.member` uids then
-                                                            [(Nothing, "Duplicate identifier '" ++ show id ++ "'")]
-                                                           else
-                                                            []
-                                                    return $ cId `Set.insert` uids
-
-class Checkable a where
-    checkReferences :: (Set AST.NodeId) -> a -> Writer [CheckFailure] Bool
-
-instance Checkable AST.NetSpec where
-    checkReferences ids (AST.NetSpec nodes) = do
-        foldM (checkNode) False nodes
-        where checkNode prevError (nodeId, node) = prependId nodeId $ runWriter $ do
-                (hasError, errors) <- listen $ checkReferences ids node
-                return $ hasError || prevError
-              prependId nodeId (hasError, errors) = writer (hasError, map (\(_, e) -> (Just nodeId, e)) errors)
-
-instance Checkable AST.NodeSpec where
-    checkReferences ids nodeSpec = do
-        foldM checkMap False $ AST.translate nodeSpec
-        case AST.overlay nodeSpec of
-            Nothing -> return False
-            Just id -> do
-                let cId  = canonicalId id
-                    undefined = cId `Set.notMember` ids
-                tell $ if undefined then
-                        [(Nothing, "Reference to undefined node '" ++ show id ++ "' in overlay")]
-                       else
-                        []
-                return undefined
-        where checkMap prevError mapSpec = do
-                hasError <- checkReferences ids mapSpec
-                return $ hasError || prevError
-
-instance Checkable AST.MapSpec where
-    checkReferences ids mapSpec = do
-        let destNode = AST.destNode mapSpec
-            cDestNode = canonicalId destNode
-            undefined = cDestNode `Set.notMember` ids
-        tell $ if undefined then
-                [(Nothing, "Reference to undefined node '" ++ show destNode ++ "' in map")]
-               else
-                []
-        return undefined
-
-{- Group the failed checks by their nodeId-}
-group :: [CheckFailure] -> [(Maybe AST.NodeId, [String])]
-group fs = Map.toList $ foldr addOrAppend Map.empty fs
-        where addOrAppend (key, error) m = if key `Map.member` m then
-                                                Map.insert key (error:(m Map.! key))  m
-                                            else
-                                                Map.insert key [error] m
-
-checkSockeye :: AST.NetSpec -> [(Maybe AST.NodeId, [String])]
-checkSockeye ast = group $ snd $ runWriter $ do
-    ids <- findUniqueIdentifiers ast
-    checkReferences ids ast
+import Data.Either
+
+import qualified SockeyeASTFrontend as ASTF
+import qualified SockeyeASTIntermediate as ASTI
+
+data FailedCheck
+    = DuplicateModule String
+    | DuplicateParameter String
+    | DuplicateVariable String
+
+instance Show FailedCheck where
+    show (DuplicateModule name)    = "Duplicate module '" ++ name ++ "'"
+    show (DuplicateParameter name) = "Duplicate parameter '" ++ name ++ "'"
+    show (DuplicateVariable name)  = "Duplicate variable '" ++ name ++ "'"
+
+newtype CheckFailure = CheckFailure
+    { failedChecks :: [FailedCheck] }
+
+instance Show CheckFailure where
+    show (CheckFailure fs) = unlines $ map (("    " ++) . show) fs
+
+checkSockeye :: ASTF.SockeyeSpec -> Either CheckFailure ASTI.SockeyeSpec
+checkSockeye ast = do
+    duplicateFree <- transform ast
+    return duplicateFree
+-- build symbol table
+-- check modules / top level namespace
+--  - no duplicate identifiers
+--  - no duplicate namespaces
+--  - all instantiated modules must exist
+--  - all nodes in maps / overlays must exist
+--  - all input ports must be specified
+--  - 
+
+-- checkModules :: ASTF.SockeyeSpec -> ASTI.SockeyeSpec -> Either CheckFailure ASTI.SockeyeSpec
+
+class ASTTransformable a b where
+    transform :: a -> Either CheckFailure b
+--
+-- Frontend AST -> Intermediate AST
+--
+instance ASTTransformable ASTF.SockeyeSpec ASTI.SockeyeSpec where
+    transform ast = do
+        let
+            modules = rootModule:(ASTF.modules ast)
+            names = map ASTF.name modules
+        checkDuplicates names DuplicateModule
+        transformed <- checkAll transform modules
+        let
+            moduleMap = Map.fromList $ zip names transformed
+        return ASTI.SockeyeSpec
+                { ASTI.modules = moduleMap }
+        where
+            rootModule =
+                let
+                    body = ASTF.ModuleBody
+                        { ASTF.ports = []
+                        , ASTF.moduleNet = ASTF.net ast
+                        }
+                in ASTF.Module
+                    { ASTF.name       = "@root"
+                    , ASTF.parameters = []
+                    , ASTF.moduleBody = body
+                    }   
+
+instance ASTTransformable ASTF.Module ASTI.Module where
+    transform ast = do
+        let
+            paramNames = map ASTF.paramName (ASTF.parameters ast)
+            paramTypes = map ASTF.paramType (ASTF.parameters ast)
+        checkDuplicates paramNames DuplicateParameter
+        let
+            portDefs = ASTF.ports $ ASTF.moduleBody ast
+        inputPorts <- checkAll transform $ filter isInPort portDefs
+        outputPorts <- checkAll transform $ filter (not . isInPort) portDefs
+        let
+            paramTypeMap = Map.fromList $ zip paramNames paramTypes
+        return ASTI.Module
+            { ASTI.paramNames  = paramNames
+            , ASTI.paramTypes  = paramTypeMap
+            , ASTI.inputPorts  = inputPorts
+            , ASTI.outputPorts = outputPorts
+            , ASTI.nodeDecls   = []
+            , ASTI.moduleInsts = []
+            }
+        where
+            isInPort (ASTF.InputPortDef _) = True
+            isInPort (ASTF.OutputPortDef _) = False
+            isInPort (ASTF.MultiPortDef for) = isInPort $ ASTF.body for
+
+instance ASTTransformable ASTF.PortDef ASTI.Port where
+    transform (ASTF.InputPortDef ident) = return $ ASTI.Port ident
+    transform (ASTF.OutputPortDef ident) = return $ ASTI.Port ident
+    transform (ASTF.MultiPortDef for) = do
+        transformed <- transform for
+        return $ ASTI.MultiPort transformed
+
+instance ASTTransformable a b => ASTTransformable (ASTF.For a) (ASTI.For b) where
+    transform ast = do
+        let
+            vars = map ASTF.var (ASTF.varRanges ast)
+        checkDuplicates vars DuplicateVariable
+        ranges <- checkAll transform (ASTF.varRanges ast)
+        body <- transform $ ASTF.body ast
+        let
+            varRanges = Map.fromList $ zip vars ranges
+        return ASTI.For
+                { ASTI.varRanges = varRanges
+                , ASTI.body      = body
+                }
+
+instance ASTTransformable ASTF.ForVarRange ASTI.ForRange where
+    transform ast = do
+        let
+            start = ASTF.start ast
+            end = ASTF.end ast
+        return ASTI.ForRange
+            { ASTI.start = start
+            , ASTI.end   = end
+            }
+
+checkDuplicates :: [String] -> (String -> FailedCheck) -> Either CheckFailure ()
+checkDuplicates names failure = do
+    let
+        duplicates = duplicateNames names
+    case duplicates of
+        [] -> return ()
+        _  -> Left $ CheckFailure (map failure duplicates)
+    where
+        duplicateNames [] = []
+        duplicateNames (x:xs)
+            | x `elem` xs = nub $ [x] ++ duplicateNames xs
+            | otherwise = duplicateNames xs  
+
+checkAll :: (a -> Either CheckFailure b) -> [a] -> Either CheckFailure [b]
+checkAll f as = do
+    let
+        bs = map f as
+        es = concat $ map failedChecks (lefts bs)
+    case es of
+        [] -> return $ rights bs
+        _  -> Left $ CheckFailure es
index 76c14df..8f26b2b 100644 (file)
@@ -104,7 +104,6 @@ portDef = choice [inputPorts, outputPorts]
 
 netSpec = choice [ inst <?> "module instantiation"
                  , decl <?> "node declaration"
-                 , multiSpecs
                  ]
     where
         inst = do
@@ -113,9 +112,6 @@ netSpec = choice [ inst <?> "module instantiation"
         decl = do
             nodeDecls <- nodeDecls
             return $ AST.NodeDeclSpec nodeDecls
-        multiSpecs = do
-            for <- for $ many1 netSpec
-            return $ AST.MultiNetSpec for
 
 moduleInst = do
     (name, args) <- try $ do
@@ -268,15 +264,6 @@ mapDest = choice [baseAddress, direct]
             destBase <- address
             return $ AST.BaseAddressMap destNode destBase
 
-for body = do
-    reserved "for"
-    varRanges <- commaSep1 $ forVarRange False
-    body <- braces body
-    return AST.For
-        { AST.varRanges = varRanges
-        , AST.body      = body
-        }
-
 identifierFor = identifierHelper True
 
 forVarRange optVarName
@@ -339,7 +326,7 @@ decimal       = P.decimal lexer <* whiteSpace
 
 keywords = ["module",
             "input", "output",
-            "for", "in",
+            "in",
             "as", "with",
             "is", "are",
             "accept", "map",