Sockeye: Rename Checker to TypeChecker
authorDaniel Schwyn <schwyda@student.ethz.ch>
Mon, 31 Jul 2017 12:14:03 +0000 (14:14 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Mon, 31 Jul 2017 12:14:03 +0000 (14:14 +0200)
Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye/Main.hs
tools/sockeye/SockeyeAST.hs [deleted file]
tools/sockeye/SockeyeASTParser.hs
tools/sockeye/SockeyeChecker.hs [deleted file]
tools/sockeye/SockeyeInstantiator.hs
tools/sockeye/SockeyeNetBuilder.hs

index 6a29119..0a55652 100644 (file)
@@ -26,12 +26,12 @@ import System.FilePath
 import System.IO
 
 import qualified SockeyeASTParser as ParseAST
-import qualified SockeyeAST as AST
+import qualified SockeyeASTTypeChecker as CheckAST
 import qualified SockeyeASTInstantiator as InstAST
 import qualified SockeyeASTDecodingNet as NetAST
 
 import SockeyeParser
-import SockeyeChecker
+import SockeyeTypeChecker
 import SockeyeInstantiator
 import SockeyeNetBuilder
 
@@ -208,17 +208,17 @@ parseFile file = do
         Right ast -> return ast
 
 {- Runs the checker -}
-checkAST :: ParseAST.SockeyeSpec -> IO AST.SockeyeSpec
-checkAST parsedAst = do
-    case checkSockeye parsedAst of 
+typeCheck :: ParseAST.SockeyeSpec -> IO CheckAST.SockeyeSpec
+typeCheck parsedAst = do
+    case typeCheckSockeye parsedAst of 
         Left fail -> do
             hPutStr stderr $ show fail
             exitWith checkError
         Right intermAst -> return intermAst
 
-instanitateModules :: AST.SockeyeSpec -> IO InstAST.SockeyeSpec
+instanitateModules :: CheckAST.SockeyeSpec -> IO InstAST.SockeyeSpec
 instanitateModules ast = do
-    case sockeyeInstantiate ast of 
+    case instantiateSockeye ast of 
         Left fail -> do
             hPutStr stderr $ show fail
             exitWith buildError
@@ -227,7 +227,7 @@ instanitateModules ast = do
 {- Builds the decoding net from the Sockeye AST -}
 buildNet :: InstAST.SockeyeSpec -> IO NetAST.NetSpec
 buildNet ast = do
-    case sockeyeBuildNet ast of 
+    case buildSockeyeNet ast of 
         Left fail -> do
             hPutStr stderr $ show fail
             exitWith buildError
@@ -237,7 +237,7 @@ buildNet ast = do
 compile :: Target -> NetAST.NetSpec -> IO String
 compile Prolog ast = return $ Prolog.compile ast
 
-{- Writes a dependency file for GNU make -}
+{- Generates a dependency file for GNU make -}
 dependencyFile :: FilePath -> FilePath -> [FilePath] -> IO String
 dependencyFile outFile depFile deps = do
     let
@@ -263,11 +263,11 @@ main = do
         Just f  -> do
             out <- dependencyFile outFile f deps
             output f out
-    ast <- checkAST parsedAst
+    ast <- typeCheck parsedAst
     instAst <- instanitateModules ast
     -- putStrLn $ groom instAST
     netAst <- buildNet instAst
-    putStrLn $ groom netAst
+    -- putStrLn $ groom netAst
     out <- compile (optTarget opts) netAst
     output outFile out
     
\ No newline at end of file
diff --git a/tools/sockeye/SockeyeAST.hs b/tools/sockeye/SockeyeAST.hs
deleted file mode 100644 (file)
index 323f8d7..0000000
+++ /dev/null
@@ -1,157 +0,0 @@
-{-
-  SockeyeAST.hs: 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 SockeyeAST 
- ( module SockeyeAST
- , module SockeyeASTInstantiator
- ) where
-
-import Data.Map (Map)
-
-import SockeyeASTInstantiator
-    ( NodeType(Other, Device, Memory) )
-
-newtype SockeyeSpec = SockeyeSpec
-    { modules :: Map String Module }
-    deriving (Show)
-
-data Module = Module
-    { paramNames   :: [String]
-    , paramTypeMap :: Map String ModuleParamType
-    , inputPorts   :: [Port]
-    , outputPorts  :: [Port]
-    , nodeDecls    :: [NodeDecl]
-    , moduleInsts  :: [ModuleInst]
-    } deriving (Show)
-
-data ModuleParamType 
-    = NaturalParam
-    | AddressParam
-    deriving (Eq)
-
-instance Show ModuleParamType where
-    show NaturalParam = "nat"
-    show AddressParam = "addr"
-
-data Port
-    = InputPort 
-        { portId    :: Identifier
-        , portWidth :: !Integer
-        }
-    | OutputPort
-        { portId    :: Identifier
-        , portWidth :: !Integer
-        }
-    | MultiPort (For Port)
-    deriving (Show)
-
-data ModuleInst
-    = ModuleInst
-        { namespace  :: Identifier
-        , moduleName :: String
-        , arguments  :: Map String ModuleArg
-        , inPortMap  :: [PortMap]
-        , outPortMap :: [PortMap]
-        }
-    | MultiModuleInst (For ModuleInst)
-    deriving (Show)
-
-data ModuleArg
-    = AddressArg !Integer
-    | NaturalArg !Integer
-    | ParamArg !String
-    deriving (Show)
-
-data PortMap
-    = PortMap
-        { mappedId   :: Identifier
-        , mappedPort :: Identifier
-        }
-    | MultiPortMap (For PortMap)
-    deriving (Show)
-
-data NodeDecl
-    = NodeDecl
-        { nodeId   :: Identifier
-        , nodeSpec :: NodeSpec
-        }
-    | MultiNodeDecl (For NodeDecl)
-    deriving (Show)
-
-data Identifier
-    = SimpleIdent 
-        { prefix  :: !String }
-    | TemplateIdent
-        { prefix  :: !String
-        , varName :: !String
-        , suffix  :: Maybe Identifier
-        }
-    deriving (Show)
-
-data NodeSpec = NodeSpec
-    { nodeType  :: NodeType
-    , accept    :: [BlockSpec]
-    , translate :: [MapSpec]
-    , reserved  :: [BlockSpec]
-    , overlay   :: Maybe OverlaySpec
-    } deriving (Show)
-
-data BlockSpec 
-    = SingletonBlock
-        { base :: Address }
-    | RangeBlock
-        { base  :: Address
-        , limit :: Address
-        }
-    | LengthBlock
-        { base :: Address
-        , bits :: !Integer
-        }
-    deriving (Show)
-
-data MapSpec 
-    = MapSpec
-        { block    :: BlockSpec
-        , destNode :: Identifier
-        , destBase :: Maybe Address
-        } deriving (Show)
-
-data OverlaySpec
-    = OverlaySpec
-        { over  :: Identifier
-        , width :: !Integer
-        } deriving (Show)
-
-data Address
-    = LiteralAddress !Integer
-    | ParamAddress !String
-    deriving (Show)
-
-data For a 
-    = For
-        { varRanges :: Map String ForRange
-        , body      :: a
-        } deriving (Show)
-
-data ForRange
-    = ForRange
-    { start :: ForLimit
-    , end   :: ForLimit
-    } deriving (Show)
-
-data ForLimit 
-    = LiteralLimit !Integer
-    | ParamLimit !String
-    deriving (Show)
index 1483991..0a214b8 100644 (file)
 
 module SockeyeASTParser 
 ( module SockeyeASTParser
-, module SockeyeAST
+, module SockeyeASTTypeChecker
 ) where
 
-import SockeyeAST
+import SockeyeASTTypeChecker
     ( Identifier(SimpleIdent, TemplateIdent)
     , prefix, varName, suffix
     , ModuleParamType(NaturalParam, AddressParam)
diff --git a/tools/sockeye/SockeyeChecker.hs b/tools/sockeye/SockeyeChecker.hs
deleted file mode 100644 (file)
index 4216d8b..0000000
+++ /dev/null
@@ -1,543 +0,0 @@
-{-
-    SockeyeChecker.hs: AST checker 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.
--}
-
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-
-module SockeyeChecker
-( checkSockeye ) where
-
-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.Either
-
-import qualified SockeyeASTParser as ParseAST
-import qualified SockeyeAST as AST
-
-data Context = Context
-    { spec       :: AST.SockeyeSpec
-    , moduleName :: !String
-    , vars       :: Set String
-    , instModule :: String
-    }
-
-data FailedCheckType
-    = DuplicateModule String
-    | DuplicateParameter String
-    | DuplicateVariable String
-    | NoSuchModule String
-    | NoSuchParameter String
-    | NoSuchVariable String
-    | ParamTypeMismatch 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, "'"]
-    show (DuplicateParameter name)       = concat ["Multiple parameters named '", name, "'"]
-    show (DuplicateVariable name)        = concat ["Multiple definitions for variable '", name, "'"]
-    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 name takes given) =
-        let arg = if takes == 1
-            then "argument"
-            else "arguments"
-        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 modName name expected actual) =
-        concat ["Type mismatch for argument '", name, "' for module '", modName, "': Expected '", show expected, "', given '", show actual, "'"]
-
-data FailedCheck = FailedCheck
-    { failure  :: FailedCheckType
-    , inModule :: !String
-    }
-
-newtype CheckFailure = CheckFailure
-    { failedChecks :: [FailedCheck] }
-
-instance Show CheckFailure where
-    show (CheckFailure fs) = 
-        let
-            modules = nub $ map inModule fs
-        in unlines $ concat (map showFailsForModule modules)
-        where
-            showFailsForModule name =
-                let
-                    title = "\nIn module '" ++ name ++ "':"
-                    fails = filter (\f -> name == inModule f) fs
-                in if name == "@root"
-                    then "":showFails 0 fails
-                    else title:showFails 1 fails
-            showFails indentLevel fs =
-                let
-                    indent = replicate (indentLevel * 4) ' '
-                in map ((indent ++) . showFail) fs
-            showFail f = (show $ failure f)
-
-checkFailure :: Context -> [FailedCheckType] -> CheckFailure
-checkFailure context fs = CheckFailure $ map failCheck fs
-    where
-        failCheck f = FailedCheck
-            { failure  = f
-            , inModule = moduleName context
-            }
-
-checkSockeye :: ParseAST.SockeyeSpec -> Either CheckFailure AST.SockeyeSpec
-checkSockeye ast = do
-    let
-        emptySpec = AST.SockeyeSpec Map.empty
-        initContext = Context
-            { spec       = emptySpec
-            , moduleName = ""
-            , vars       = Set.empty
-            , instModule = ""
-            }
-    symbolTable <- buildSymbolTable initContext ast
-    let
-        context = initContext
-            { spec = symbolTable }
-    check context ast
-
---
--- Build Symbol table
---
-class SymbolSource a b where
-    buildSymbolTable :: Context -> a -> Either CheckFailure b
-
-instance SymbolSource ParseAST.SockeyeSpec AST.SockeyeSpec where
-    buildSymbolTable context ast = do
-        let
-            modules = (rootModule ast):(ParseAST.modules ast)
-            names = map ParseAST.name modules
-        checkDuplicates context names DuplicateModule
-        symbolTables <- buildSymbolTable context modules
-        let
-            moduleMap = Map.fromList $ zip names symbolTables
-        return AST.SockeyeSpec
-                { AST.modules = moduleMap }
-
-instance SymbolSource ParseAST.Module AST.Module where
-    buildSymbolTable context ast = do
-        let
-            name = ParseAST.name ast
-            paramNames = map ParseAST.paramName (ParseAST.parameters ast)
-            paramTypes = map ParseAST.paramType (ParseAST.parameters ast)
-            moduleContext = context
-                { moduleName = name}
-        checkDuplicates moduleContext paramNames DuplicateParameter
-        let
-            paramTypeMap = Map.fromList $ zip paramNames paramTypes
-        return AST.Module
-            { AST.paramNames   = paramNames
-            , AST.paramTypeMap = paramTypeMap
-            , AST.inputPorts   = []
-            , AST.outputPorts  = []
-            , AST.nodeDecls    = []
-            , AST.moduleInsts  = []
-            }
-
-instance SymbolSource a b => SymbolSource [a] [b] where
-    buildSymbolTable context as = forAll (buildSymbolTable context) as
-
---
--- Check module bodies
---
-class Checkable a b where
-    check :: Context -> a -> Either CheckFailure b
-
-instance Checkable ParseAST.SockeyeSpec AST.SockeyeSpec where
-    check context ast = do
-        let
-            modules = (rootModule ast):(ParseAST.modules ast)
-            names = map ParseAST.name modules
-        checked <- check context modules
-        let
-            sockeyeSpec = spec context
-            checkedMap = Map.fromList $ zip names checked
-        return sockeyeSpec
-            { AST.modules = checkedMap }
-
-instance Checkable ParseAST.Module AST.Module where
-    check context ast = do
-        let
-            name = ParseAST.name ast
-            bodyContext = context
-                { moduleName = name}
-            body = ParseAST.moduleBody ast
-            portDefs = ParseAST.ports body
-            netSpecs = ParseAST.moduleNet body
-        inputPorts  <- check bodyContext $ filter isInPort  portDefs
-        outputPorts <- check bodyContext $ filter isOutPort portDefs
-        checkedNetSpecs <- check bodyContext netSpecs
-        let
-            checkedNodeDecls = lefts checkedNetSpecs
-            checkedModuleInsts = rights checkedNetSpecs
-            mod = getCurrentModule bodyContext
-        return mod
-            { AST.inputPorts  = inputPorts
-            , AST.outputPorts = outputPorts
-            , AST.nodeDecls   = checkedNodeDecls
-            , AST.moduleInsts = checkedModuleInsts
-            }
-        where
-            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 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
-
-instance Checkable ParseAST.NetSpec (Either AST.NodeDecl AST.ModuleInst) where
-    check context (ParseAST.NodeDeclSpec decl) = do
-        checkedDecl <- check context decl
-        return $ Left checkedDecl
-    check context (ParseAST.ModuleInstSpec inst) = do
-        checkedInst <- check context inst
-        return $ Right checkedInst
-
-instance Checkable ParseAST.ModuleInst AST.ModuleInst where
-    check context (ParseAST.MultiModuleInst for) = do
-        checkedFor <- check context for
-        return $ AST.MultiModuleInst checkedFor
-    check context ast = do
-        let
-            namespace = ParseAST.namespace ast
-            name = ParseAST.moduleName ast
-            arguments = ParseAST.arguments ast
-            portMaps = ParseAST.portMappings ast
-            instContext = context
-                { instModule = name }
-        checkedArgs <- check instContext arguments
-        checkedNamespace <- check instContext namespace
-        inPortMap  <- check instContext $ filter isInMap  portMaps
-        outPortMap <- check instContext $ filter isOutMap portMaps
-        return AST.ModuleInst
-            { AST.namespace  = checkedNamespace
-            , AST.moduleName = name
-            , AST.arguments  = checkedArgs
-            , AST.inPortMap  = inPortMap
-            , AST.outPortMap = outPortMap
-            }
-        where
-            isInMap (ParseAST.InputPortMap {}) = True
-            isInMap (ParseAST.MultiPortMap for) = isInMap $ ParseAST.body for
-            isInMap _ = False
-            isOutMap = not . isInMap
-
-instance Checkable [ParseAST.ModuleArg] (Map String AST.ModuleArg) where
-    check context args = do
-        mod <- getInstantiatedModule context
-        let
-            typeMap = AST.paramTypeMap mod
-            paramNames = AST.paramNames mod
-            paramTypes = map (typeMap Map.!) paramNames
-            params = zip paramNames paramTypes
-        checkArgCount paramNames args
-        checkedArgs <- forAll id $ zipWith checkArgType params args
-        return $ Map.fromList $ zip paramNames checkedArgs
-        where
-            checkArgCount params args = do
-                let
-                    paramc = length params
-                    argc = length args
-                if argc == paramc
-                    then return ()
-                    else Left $ checkFailure context [WrongNumberOfArgs (instModule context) paramc argc]
-            checkArgType (name, expected) arg = do
-                case arg of
-                    ParseAST.AddressArg value -> do
-                        if expected == AST.AddressParam
-                            then return $ AST.AddressArg value
-                            else Left $ mismatch AST.AddressParam
-                    ParseAST.NaturalArg value -> do
-                        if expected == AST.NaturalParam
-                            then return $ AST.NaturalArg value
-                            else Left $ mismatch AST.NaturalParam
-                    ParseAST.ParamArg pName -> do
-                        checkParamType context pName expected
-                        return $ AST.ParamArg pName
-                where
-                    mismatch t = checkFailure context [ArgTypeMismatch (instModule context) name expected t]
-
-instance Checkable ParseAST.PortMap AST.PortMap where
-    check context (ParseAST.MultiPortMap for) = do
-        checkedFor <- check context for
-        return $ AST.MultiPortMap checkedFor
-    check context portMap = do
-        let
-            mappedId = ParseAST.mappedId portMap
-            mappedPort = ParseAST.mappedPort portMap
-        (checkedId, checkedPort) <- check context (mappedId, mappedPort)
-        return $ AST.PortMap
-            { AST.mappedId   = checkedId
-            , AST.mappedPort = checkedPort
-            }
-
-instance Checkable ParseAST.NodeDecl AST.NodeDecl where
-    check context (ParseAST.MultiNodeDecl for) = do
-        checkedFor <- check context for
-        return $ AST.MultiNodeDecl checkedFor
-    check context ast = do
-        let
-            nodeId = ParseAST.nodeId ast
-            nodeSpec = ParseAST.nodeSpec ast
-        checkedId <- check context nodeId
-        checkedSpec <- check context nodeSpec
-        return AST.NodeDecl
-            { AST.nodeId   = checkedId
-            , AST.nodeSpec = checkedSpec
-            }
-
-instance Checkable ParseAST.Identifier AST.Identifier where
-    check _ (ParseAST.SimpleIdent name) = return $ AST.SimpleIdent name
-    check context ast = do
-        let
-            prefix = ParseAST.prefix ast
-            varName = ParseAST.varName ast
-            suffix = ParseAST.suffix ast
-        checkVarInScope context varName
-        checkedSuffix <- case suffix of
-            Nothing    -> return Nothing
-            Just ident -> do
-                checkedIdent <- check context ident
-                return $ Just checkedIdent
-        return AST.TemplateIdent
-            { AST.prefix  = prefix
-            , AST.varName = varName
-            , AST.suffix  = checkedSuffix
-            }
-
-instance Checkable ParseAST.NodeSpec AST.NodeSpec where
-    check context ast = do
-        let 
-            nodeType = ParseAST.nodeType ast
-            accept = ParseAST.accept ast
-            translate = ParseAST.translate ast
-            overlay = ParseAST.overlay ast
-            reserved = ParseAST.reserved ast
-        checkedAccept <- check context accept
-        checkedTranslate <- check context translate
-        checkedReserved <- check context reserved
-        checkedOverlay <- case overlay of
-            Nothing    -> return Nothing
-            Just ident -> do
-                checkedIdent <- check context ident
-                return $ Just checkedIdent
-        return AST.NodeSpec
-            { AST.nodeType  = nodeType
-            , AST.accept    = checkedAccept
-            , AST.translate = checkedTranslate
-            , AST.reserved  = checkedReserved
-            , AST.overlay   = checkedOverlay
-            }
-
-instance Checkable ParseAST.BlockSpec AST.BlockSpec where
-    check context (ParseAST.SingletonBlock address) = do
-        checkedAddress <- check context address
-        return AST.SingletonBlock
-            { AST.base = checkedAddress }
-    check context (ParseAST.RangeBlock base limit) = do
-        (checkedBase, checkedLimit) <- check context (base, limit)
-        return AST.RangeBlock
-            { AST.base  = checkedBase
-            , AST.limit = checkedLimit
-            }
-    check context (ParseAST.LengthBlock base bits) = do
-        checkedBase <- check context base
-        return AST.LengthBlock
-            { AST.base = checkedBase
-            , AST.bits = bits
-            }
-
-instance Checkable ParseAST.MapSpec AST.MapSpec where
-    check context ast = do
-        let
-            block = ParseAST.block ast
-            destNode = ParseAST.destNode ast
-            destBase = ParseAST.destBase ast
-        checkedBlock <- check context block
-        checkedDestNode <- check context destNode
-        checkedDestBase <- case destBase of
-            Nothing      -> return Nothing
-            Just address -> do
-                checkedAddress <- check context address
-                return $ Just checkedAddress
-        return AST.MapSpec
-            { AST.block    = checkedBlock
-            , AST.destNode = checkedDestNode
-            , 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
-    check context (ParseAST.ParamAddress name) = do
-        checkParamType context name AST.AddressParam
-        return $ AST.ParamAddress name
-
-instance Checkable a b => Checkable (ParseAST.For a) (AST.For b) where
-    check context ast = do
-        let
-            varRanges = ParseAST.varRanges ast
-            varNames = map ParseAST.var varRanges
-            body = ParseAST.body ast
-        checkDuplicates context varNames DuplicateVariable
-        ranges <- check context varRanges
-        let
-            currentVars = vars context
-            bodyVars = currentVars `Set.union` (Set.fromList varNames)
-            bodyContext = context
-                { vars = bodyVars }
-        checkedBody <- check bodyContext body
-        let
-            checkedVarRanges = Map.fromList $ zip varNames ranges
-        return AST.For
-                { AST.varRanges = checkedVarRanges
-                , AST.body      = checkedBody
-                }
-
-instance Checkable ParseAST.ForVarRange AST.ForRange where
-    check context ast = do
-        let 
-            start = ParseAST.start ast
-            end = ParseAST.end ast
-        (checkedStart, checkedEnd) <- check context (start, end)
-        return AST.ForRange
-            { AST.start = checkedStart
-            , AST.end   = checkedEnd
-            }
-
-instance Checkable ParseAST.ForLimit AST.ForLimit where
-    check _ (ParseAST.LiteralLimit value) = do
-        return $ AST.LiteralLimit value
-    check context (ParseAST.ParamLimit name) = do
-        checkParamType context name AST.NaturalParam
-        return $ AST.ParamLimit name
-
-instance Checkable a b => Checkable [a] [b] where
-    check context as = forAll (check context) as
-
-instance (Checkable a c, Checkable b d) => Checkable (a, b) (c, d) where
-    check context (a, b) =
-        let
-            eitherC = check context a
-            eitherD = check context b
-        in case (eitherC, eitherD) of
-            (Right c, Right d) -> return (c, d)
-            (Left e1, Left e2) -> Left $ CheckFailure (concat $ map failedChecks [e1, e2])
-            (Left e1, _)       -> Left $ e1
-            (_      , Left e2) -> Left $ e2
---
--- Helpers
---
-rootModule :: ParseAST.SockeyeSpec -> ParseAST.Module
-rootModule spec =
-    let
-        body = ParseAST.ModuleBody
-            { ParseAST.ports = []
-            , ParseAST.moduleNet = ParseAST.net spec
-            }
-    in ParseAST.Module
-        { ParseAST.name       = "@root"
-        , ParseAST.parameters = []
-        , ParseAST.moduleBody = body
-        }
-
-getModule :: Context -> String -> Either CheckFailure AST.Module
-getModule context name = do
-    let
-        modMap = AST.modules $ spec context
-    case Map.lookup name modMap of
-        Nothing -> Left $ checkFailure context [NoSuchModule name]
-        Just m  -> return m
-
-getCurrentModule :: Context -> AST.Module
-getCurrentModule context =
-    let
-        modMap = AST.modules $ spec context
-    in modMap Map.! (moduleName context)
-
-getInstantiatedModule :: Context -> Either CheckFailure AST.Module
-getInstantiatedModule context =
-    let
-        modName = instModule context
-    in getModule context modName
-
-getParameterType :: Context -> String -> Either CheckFailure AST.ModuleParamType
-getParameterType context name = do
-    let
-        mod = getCurrentModule context
-        paramMap = AST.paramTypeMap mod
-    case Map.lookup name paramMap of
-        Nothing -> Left $ checkFailure context [NoSuchParameter name]
-        Just t  -> return t
-
-forAll :: (a -> Either CheckFailure b) -> [a] -> Either CheckFailure [b]
-forAll f as = do
-    let
-        bs = map f as
-        es = concat $ map failedChecks (lefts bs)
-    case es of
-        [] -> return $ rights bs
-        _  -> Left $ CheckFailure es
-
-checkDuplicates :: Context -> [String] -> (String -> FailedCheckType) -> Either CheckFailure ()
-checkDuplicates context names failure = do
-    let
-        duplicates = duplicateNames names
-    case duplicates of
-        [] -> return ()
-        _  -> Left $ checkFailure context (map failure duplicates)
-    where
-        duplicateNames [] = []
-        duplicateNames (x:xs)
-            | x `elem` xs = nub $ [x] ++ duplicateNames xs
-            | otherwise = duplicateNames xs
-
-checkVarInScope :: Context -> String -> Either CheckFailure ()
-checkVarInScope context name = do
-    if name `Set.member` (vars context)
-        then return ()
-        else Left $ checkFailure context [NoSuchVariable name]
-
-
-checkParamType :: Context -> String -> AST.ModuleParamType -> Either CheckFailure ()
-checkParamType context name expected = do
-    actual <- getParameterType context name
-    if actual == expected
-        then return ()
-        else Left $ mismatch actual
-    where
-        mismatch t = checkFailure context [ParamTypeMismatch name expected t]
index 7f268cc..5e6e1a6 100644 (file)
@@ -18,7 +18,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module SockeyeInstantiator
-( sockeyeInstantiate ) where
+( instantiateSockeye ) where
 
 import Control.Monad.State
 
@@ -33,7 +33,7 @@ import Numeric (showHex)
 
 import SockeyeChecks
 
-import qualified SockeyeAST as AST
+import qualified SockeyeASTTypeChecker as CheckAST
 import qualified SockeyeASTInstantiator as InstAST
 
 import Text.Groom (groom)
@@ -66,15 +66,15 @@ instance Show InstFails where
 type PortMapping = (InstAST.Identifier, InstAST.Identifier)
 
 data Context = Context
-    { spec        :: AST.SockeyeSpec
+    { spec        :: CheckAST.SockeyeSpec
     , modulePath  :: [String]
     , paramValues :: Map String Integer
     , varValues   :: Map String Integer
     }
 
-sockeyeInstantiate :: AST.SockeyeSpec -> Either (FailedChecks InstFails) InstAST.SockeyeSpec
-sockeyeInstantiate ast = do
-    let emptySpec = AST.SockeyeSpec Map.empty
+instantiateSockeye :: CheckAST.SockeyeSpec -> Either (FailedChecks InstFails) InstAST.SockeyeSpec
+instantiateSockeye ast = do
+    let emptySpec = CheckAST.SockeyeSpec Map.empty
         context = Context
             { spec        = emptySpec
             , modulePath  = []
@@ -89,14 +89,14 @@ sockeyeInstantiate ast = do
 class Instantiatable a b where
     instantiate :: Context -> a -> StateT (Map String InstAST.Module) (Checks InstFails) b
 
-instance Instantiatable AST.SockeyeSpec InstAST.SockeyeSpec where
+instance Instantiatable CheckAST.SockeyeSpec InstAST.SockeyeSpec where
     instantiate context ast = do
-        let rootInst = AST.ModuleInst
-                { AST.namespace  = AST.SimpleIdent ""
-                , AST.moduleName = "@root"
-                , AST.arguments  = Map.empty
-                , AST.inPortMap  = []
-                , AST.outPortMap = []
+        let rootInst = CheckAST.ModuleInst
+                { CheckAST.namespace  = CheckAST.SimpleIdent ""
+                , CheckAST.moduleName = "@root"
+                , CheckAST.arguments  = Map.empty
+                , CheckAST.inPortMap  = []
+                , CheckAST.outPortMap = []
                 }
             specContext = context
                 { spec = ast }
@@ -107,12 +107,12 @@ instance Instantiatable AST.SockeyeSpec InstAST.SockeyeSpec where
             , InstAST.modules = modules
             }
 
-instance Instantiatable AST.Module InstAST.Module where
+instance Instantiatable CheckAST.Module InstAST.Module where
     instantiate context ast = do
-        let inPorts = AST.inputPorts ast
-            outPorts = AST.outputPorts ast
-            nodeDecls = AST.nodeDecls ast
-            moduleInsts = AST.moduleInsts ast
+        let inPorts = CheckAST.inputPorts ast
+            outPorts = CheckAST.outputPorts ast
+            nodeDecls = CheckAST.nodeDecls ast
+            moduleInsts = CheckAST.moduleInsts ast
             modName = head $ modulePath context
         modules <- get
         if modName `Map.member` modules
@@ -150,22 +150,22 @@ instance Instantiatable AST.Module InstAST.Module where
             isOutPort (InstAST.InputPort  {}) = False
             isOutPort (InstAST.OutputPort {}) = True
 
-instance Instantiatable AST.Port [InstAST.Port] where
-    instantiate context (AST.MultiPort for) = do
+instance Instantiatable CheckAST.Port [InstAST.Port] where
+    instantiate context (CheckAST.MultiPort for) = do
         instFor <- instantiate context for
         return $ concat (instFor :: [[InstAST.Port]])
-    instantiate context ast@(AST.InputPort {}) = do
-        let ident = AST.portId ast
-            width = AST.portWidth ast
+    instantiate context ast@(CheckAST.InputPort {}) = do
+        let ident = CheckAST.portId ast
+            width = CheckAST.portWidth ast
         instIdent <- instantiate context ident
         let instPort = InstAST.InputPort
                 { InstAST.portId    = instIdent
                 , InstAST.portWidth = width
                 }
         return [instPort]
-    instantiate context ast@(AST.OutputPort {}) = do
-        let ident = AST.portId ast
-            width = AST.portWidth ast
+    instantiate context ast@(CheckAST.OutputPort {}) = do
+        let ident = CheckAST.portId ast
+            width = CheckAST.portWidth ast
         instIdent <- instantiate context ident
         let instPort = InstAST.OutputPort
                 { InstAST.portId    = instIdent
@@ -173,16 +173,16 @@ instance Instantiatable AST.Port [InstAST.Port] where
                 }
         return [instPort]
 
-instance Instantiatable AST.ModuleInst [InstAST.ModuleInst] where
-    instantiate context (AST.MultiModuleInst for) = do 
+instance Instantiatable CheckAST.ModuleInst [InstAST.ModuleInst] where
+    instantiate context (CheckAST.MultiModuleInst for) = do 
         simpleFor <- instantiate context for
         return $ concat (simpleFor :: [[InstAST.ModuleInst]])
     instantiate context ast = do
-        let namespace = AST.namespace ast
-            name = AST.moduleName ast
-            args = AST.arguments ast
-            inPortMap = AST.inPortMap ast
-            outPortMap = AST.outPortMap ast
+        let namespace = CheckAST.namespace ast
+            name = CheckAST.moduleName ast
+            args = CheckAST.arguments ast
+            inPortMap = CheckAST.inPortMap ast
+            outPortMap = CheckAST.outPortMap ast
             modPath = modulePath context
             mod = getModule context name
         instNs <- instantiate context namespace
@@ -213,13 +213,13 @@ instance Instantiatable AST.ModuleInst [InstAST.ModuleInst] where
         return [instantiated]
         where
             argStrings args mod =
-                let paramNames = AST.paramNames mod
-                    paramTypes = AST.paramTypeMap mod
+                let paramNames = CheckAST.paramNames mod
+                    paramTypes = CheckAST.paramTypeMap mod
                     params = map (\p -> (p, paramTypes Map.! p)) paramNames
                 in map showValue params
                     where
-                        showValue (name, AST.AddressParam)  = "0x" ++ showHex (args Map.! name) ""
-                        showValue (name, AST.NaturalParam) = show (args Map.! name)
+                        showValue (name, CheckAST.AddressParam)  = "0x" ++ showHex (args Map.! name) ""
+                        showValue (name, CheckAST.NaturalParam) = show (args Map.! name)
             checkSelfInst path name = do
                 case loop path of
                     [] -> return ()
@@ -230,29 +230,29 @@ instance Instantiatable AST.ModuleInst [InstAST.ModuleInst] where
                             | name `elem` path = p:(loop ps)
                             | otherwise = []
 
-instance Instantiatable AST.ModuleArg Integer where
-    instantiate _ (AST.AddressArg v) = return v
-    instantiate _ (AST.NaturalArg v) = return v
-    instantiate context (AST.ParamArg name) = return $ getParamValue context name
+instance Instantiatable CheckAST.ModuleArg Integer where
+    instantiate _ (CheckAST.AddressArg value) = return value
+    instantiate _ (CheckAST.NaturalArg value) = return value
+    instantiate context (CheckAST.ParamArg name) = return $ getParamValue context name
 
-instance Instantiatable AST.PortMap [PortMapping] where
-    instantiate context (AST.MultiPortMap for) = do
+instance Instantiatable CheckAST.PortMap [PortMapping] where
+    instantiate context (CheckAST.MultiPortMap for) = do
         instFor <- instantiate context for
         return $ concat (instFor :: [[PortMapping]])
     instantiate context ast = do
-        let mappedId = AST.mappedId ast
-            mappedPort = AST.mappedPort ast
+        let mappedId = CheckAST.mappedId ast
+            mappedPort = CheckAST.mappedPort ast
         instId <- instantiate context mappedId
         instPort <- instantiate context mappedPort
         return [(instPort, instId)]
 
-instance Instantiatable AST.NodeDecl [InstAST.NodeDecl] where
-    instantiate context (AST.MultiNodeDecl for) = do
+instance Instantiatable CheckAST.NodeDecl [InstAST.NodeDecl] where
+    instantiate context (CheckAST.MultiNodeDecl for) = do
         instFor <- instantiate context for
         return $ concat (instFor :: [[InstAST.NodeDecl]])
     instantiate context ast = do
-        let nodeId = AST.nodeId ast
-            nodeSpec = AST.nodeSpec ast
+        let nodeId = CheckAST.nodeId ast
+            nodeSpec = CheckAST.nodeSpec ast
         instNodeId <- instantiate context nodeId
         instNodeSpec <- instantiate context nodeSpec
         let instDecl = InstAST.NodeDecl
@@ -261,26 +261,26 @@ instance Instantiatable AST.NodeDecl [InstAST.NodeDecl] where
                 }
         return $ [instDecl]
 
-instance Instantiatable AST.Identifier InstAST.Identifier where
-    instantiate context (AST.SimpleIdent name) = do
+instance Instantiatable CheckAST.Identifier InstAST.Identifier where
+    instantiate context (CheckAST.SimpleIdent name) = do
         return name
     instantiate context ast = do
-        let prefix = AST.prefix ast
-            varName = AST.varName ast
-            suffix = AST.suffix ast
+        let prefix = CheckAST.prefix ast
+            varName = CheckAST.varName ast
+            suffix = CheckAST.suffix ast
             varValue = show $ getVarValue context varName
         suffixName <- case suffix of
             Nothing -> return ""
             Just s  -> instantiate context s
         return $ prefix ++ varValue ++ suffixName
 
-instance Instantiatable AST.NodeSpec InstAST.NodeSpec where
+instance Instantiatable CheckAST.NodeSpec InstAST.NodeSpec where
     instantiate context ast = do
-        let nodeType = AST.nodeType ast
-            accept = AST.accept ast
-            translate = AST.translate ast
-            reserved = AST.reserved ast
-            overlay = AST.overlay ast
+        let nodeType = CheckAST.nodeType ast
+            accept = CheckAST.accept ast
+            translate = CheckAST.translate ast
+            reserved = CheckAST.reserved ast
+            overlay = CheckAST.overlay ast
         instAccept <- instantiate context accept
         instTranslate <- instantiate context translate
         instReserved <- instantiate context reserved
@@ -293,26 +293,26 @@ instance Instantiatable AST.NodeSpec InstAST.NodeSpec where
             , InstAST.overlay   = instOverlay
             }
 
-instance Instantiatable AST.NodeType InstAST.NodeType where
-    instantiate _ AST.Memory = return InstAST.Memory
-    instantiate _ AST.Device = return InstAST.Device
-    instantiate _ AST.Other  = return InstAST.Other
+instance Instantiatable CheckAST.NodeType InstAST.NodeType where
+    instantiate _ CheckAST.Memory = return InstAST.Memory
+    instantiate _ CheckAST.Device = return InstAST.Device
+    instantiate _ CheckAST.Other  = return InstAST.Other
 
-instance Instantiatable AST.BlockSpec InstAST.BlockSpec where
-    instantiate context (AST.SingletonBlock base) = do
+instance Instantiatable CheckAST.BlockSpec InstAST.BlockSpec where
+    instantiate context (CheckAST.SingletonBlock base) = do
         instBase <- instantiate context base
         return InstAST.BlockSpec
             { InstAST.base  = instBase
             , InstAST.limit = instBase
             }
-    instantiate context (AST.RangeBlock base limit) = do
+    instantiate context (CheckAST.RangeBlock base limit) = do
         instBase <- instantiate context base
         instLimit <- instantiate context limit
         return InstAST.BlockSpec
             { InstAST.base  = instBase
             , InstAST.limit = instLimit
             }
-    instantiate context (AST.LengthBlock base bits) = do
+    instantiate context (CheckAST.LengthBlock base bits) = do
         instBase <- instantiate context base
         let instLimit = instBase + 2^bits - 1
         return InstAST.BlockSpec
@@ -320,11 +320,11 @@ instance Instantiatable AST.BlockSpec InstAST.BlockSpec where
             , InstAST.limit = instLimit
             }
 
-instance Instantiatable AST.MapSpec InstAST.MapSpec where
+instance Instantiatable CheckAST.MapSpec InstAST.MapSpec where
     instantiate context ast = do
-        let block = AST.block ast
-            destNode = AST.destNode ast
-            destBase = fromMaybe (AST.base block) (AST.destBase ast)
+        let block = CheckAST.block ast
+            destNode = CheckAST.destNode ast
+            destBase = fromMaybe (CheckAST.base block) (CheckAST.destBase ast)
         instBlock <- instantiate context block
         instDestNode <- instantiate context destNode
         instDestBase <- instantiate context destBase
@@ -334,26 +334,26 @@ instance Instantiatable AST.MapSpec InstAST.MapSpec where
             , InstAST.destBase = instDestBase
             }
 
-instance Instantiatable AST.OverlaySpec InstAST.OverlaySpec where
+instance Instantiatable CheckAST.OverlaySpec InstAST.OverlaySpec where
     instantiate context ast = do
-        let over = AST.over ast
-            width = AST.width ast
+        let over = CheckAST.over ast
+            width = CheckAST.width ast
         instOver <- instantiate context over
         return InstAST.OverlaySpec
             { InstAST.over  = instOver
             , InstAST.width = width
             }
 
-instance Instantiatable AST.Address InstAST.Address where
-    instantiate context (AST.ParamAddress name) = do
+instance Instantiatable CheckAST.Address InstAST.Address where
+    instantiate context (CheckAST.ParamAddress name) = do
         let value = getParamValue context name
         return value
-    instantiate _ (AST.LiteralAddress value) = return value
+    instantiate _ (CheckAST.LiteralAddress value) = return value
 
-instance Instantiatable a b => Instantiatable (AST.For a) [b] where
+instance Instantiatable a b => Instantiatable (CheckAST.For a) [b] where
     instantiate context ast = do
-        let body = AST.body ast
-            varRanges = AST.varRanges ast
+        let body = CheckAST.body ast
+            varRanges = CheckAST.varRanges ast
         concreteRanges <- instantiate context varRanges
         let valueList = Map.foldWithKey iterations [] concreteRanges
             iterContexts = map iterationContext valueList
@@ -369,25 +369,25 @@ instance Instantiatable a b => Instantiatable (AST.For a) [b] where
                 in context
                     { varValues = values `Map.union` varMap }
 
-instance Instantiatable AST.ForRange [Integer] where
+instance Instantiatable CheckAST.ForRange [Integer] where
     instantiate context ast = do
-        let start = AST.start ast
-            end = AST.end ast
+        let start = CheckAST.start ast
+            end = CheckAST.end ast
         simpleStart <- instantiate context start
         simpleEnd <- instantiate context end
         return [simpleStart..simpleEnd]
 
-instance Instantiatable AST.ForLimit Integer where
-    instantiate _ (AST.LiteralLimit value) = return value
-    instantiate context (AST.ParamLimit name) = return $ getParamValue context name
+instance Instantiatable CheckAST.ForLimit Integer where
+    instantiate _ (CheckAST.LiteralLimit value) = return value
+    instantiate context (CheckAST.ParamLimit name) = return $ getParamValue context name
 
 instance (Traversable t, Instantiatable a b) => Instantiatable (t a) (t b) where
     instantiate context ast = mapM (instantiate context) ast
 
 
-getModule :: Context -> String -> AST.Module
+getModule :: Context -> String -> CheckAST.Module
 getModule context name =
-    let modules = AST.modules $ spec context
+    let modules = CheckAST.modules $ spec context
     in modules Map.! name
 
 getParamValue :: Context -> String -> Integer
index abaec41..22685d6 100644 (file)
@@ -18,7 +18,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module SockeyeNetBuilder
-( sockeyeBuildNet ) where
+( buildSockeyeNet ) where
 
 import Control.Monad.State
 
@@ -57,8 +57,8 @@ data Context = Context
     , mappedBlocks :: [InstAST.BlockSpec]
     }
 
-sockeyeBuildNet :: InstAST.SockeyeSpec -> Either (FailedChecks NetBuildFails) NetAST.NetSpec
-sockeyeBuildNet ast = do
+buildSockeyeNet :: InstAST.SockeyeSpec -> Either (FailedChecks NetBuildFails) NetAST.NetSpec
+buildSockeyeNet ast = do
     let
         context = Context
             { modules      = Map.empty