Sockeye: implement reference check inside node declarations
[barrelfish] / tools / sockeye / SockeyeInstantiator.hs
index f9cd72c..7926ca0 100644 (file)
@@ -39,7 +39,7 @@ import qualified SockeyeASTInstantiator as InstAST
 import Text.Groom (groom)
 import Debug.Trace
 
-data InstFails
+data InstFail
     = ModuleInstLoop     [String]
     | DuplicateNamespace !String
     | DuplicateIdentifer !String
@@ -47,11 +47,8 @@ data InstFails
     | DuplicateOutPort   !String
     | DuplicateInMap     !String !String
     | DuplicateOutMap    !String !String
-    | UndefinedOutPort   !String !String
-    | UndefinedInPort    !String !String
-    | UndefinedReference !String !String
 
-instance Show InstFails where
+instance Show InstFail where
     show (ModuleInstLoop     loop)       = concat ["Module instantiation loop: '", intercalate "' -> '" loop, "'"]
     show (DuplicateInPort    port)       = concat ["Multiple declarations of input port '", port, "'"]
     show (DuplicateOutPort   port)       = concat ["Multiple declarations of output port '", port, "'"]
@@ -59,9 +56,6 @@ instance Show InstFails where
     show (DuplicateIdentifer ident)      = concat ["Multiple declarations of node '", ident, "'"]
     show (DuplicateInMap   inst port)    = concat ["Multiple mappings for input port '",  port, "' in module instantiation '", inst, "'"]
     show (DuplicateOutMap  inst port)    = concat ["Multiple mappings for output port '", port, "' in module instantiation '", inst, "'"]
-    show (UndefinedInPort  inst port)    = concat ["Mapping to undefined input port '",   port, "' in module instantiation '", inst, "'"]
-    show (UndefinedOutPort inst port)    = concat ["Mapping to undefined output port '",  port, "' in module instantiation '", inst, "'"]
-    show (UndefinedReference decl ident) = concat ["Reference to undefined node '", ident, "' in declaration of node '", decl, "'"]
 
 type PortMapping = (InstAST.Identifier, InstAST.Identifier)
 
@@ -72,7 +66,7 @@ data Context = Context
     , varValues   :: Map String Integer
     }
 
-instantiateSockeye :: CheckAST.SockeyeSpec -> Either (FailedChecks InstFails) InstAST.SockeyeSpec
+instantiateSockeye :: CheckAST.SockeyeSpec -> Either (FailedChecks InstFail) InstAST.SockeyeSpec
 instantiateSockeye ast = do
     let emptySpec = CheckAST.SockeyeSpec 
         context = Context
@@ -87,7 +81,7 @@ instantiateSockeye ast = do
 -- Instantiate Module Templates
 --
 class Instantiatable a b where
-    instantiate :: Context -> a -> StateT (Map String InstAST.Module) (Checks InstFails) b
+    instantiate :: Context -> a -> StateT (Map String InstAST.Module) (Checks InstFail) b
 
 instance Instantiatable CheckAST.SockeyeSpec InstAST.SockeyeSpec where
     instantiate context ast = do
@@ -105,8 +99,8 @@ instance Instantiatable CheckAST.SockeyeSpec InstAST.SockeyeSpec where
 instance Instantiatable CheckAST.Module InstAST.Module where
     instantiate context ast = do
         let ports = CheckAST.ports ast
-            nodeDecls = CheckAST.nodeDecls ast
             moduleInsts = CheckAST.moduleInsts ast
+            nodeDecls = CheckAST.nodeDecls ast
             modName = head $ modulePath context
         modules <- get
         if modName `Map.member` modules
@@ -114,27 +108,36 @@ instance Instantiatable CheckAST.Module InstAST.Module where
                 return $ modules Map.! modName
             else do
                 let sentinel = InstAST.Module
-                        { InstAST.ports       = []
+                        { InstAST.inputPorts  = []
+                        , InstAST.outputPorts = []
                         , InstAST.nodeDecls   = []
                         , InstAST.moduleInsts = []
                         }
                 modify $ Map.insert modName sentinel
-                instPorts <- do
+                (instInPorts, instOutPorts) <- do
                     instPorts <- instantiate context ports
-                    return $ concat (instPorts :: [[InstAST.Port]])
-                instDecls <- do
-                    decls <- instantiate context nodeDecls
-                    return $ concat (decls :: [[InstAST.NodeDecl]])
+                    let allPorts = concat (instPorts :: [[InstAST.Port]])
+                        inPorts = filter isInPort allPorts
+                        outPorts = filter isOutPort allPorts
+                    return (inPorts, outPorts)
                 instInsts <- do
                     insts <- instantiate context moduleInsts
                     return $ concat (insts :: [[InstAST.ModuleInst]])
-                lift $ checkDuplicates modName DuplicateInPort    $ (map InstAST.portId $ filter isInPort  instPorts)
-                lift $ checkDuplicates modName DuplicateOutPort   $ (map InstAST.portId $ filter isOutPort instPorts)
-                lift $ checkDuplicates modName DuplicateIdentifer $ (map InstAST.nodeId instDecls)
+                instDecls <- do
+                    decls <- instantiate context nodeDecls
+                    return $ concat (decls :: [[InstAST.NodeDecl]])
+                let
+                    inPortIds = map InstAST.portId instInPorts
+                    outPortIds = map InstAST.portId instOutPorts
+                    inMapNodeIds = concat $ map (Map.elems . InstAST.inPortMap) instInsts
+                    declNodeIds = map InstAST.nodeId instDecls
+                lift $ checkDuplicates modName DuplicateInPort  inPortIds
+                lift $ checkDuplicates modName DuplicateOutPort outPortIds
                 lift $ checkDuplicates modName DuplicateNamespace $ (map InstAST.namespace instInsts)
-                -- TODO: check duplicates with input/output ports
+                lift $ checkDuplicates modName DuplicateIdentifer $ outPortIds ++ inMapNodeIds ++ declNodeIds
                 return InstAST.Module
-                    { InstAST.ports       = instPorts
+                    { InstAST.inputPorts  = instInPorts
+                    , InstAST.outputPorts = instOutPorts
                     , InstAST.nodeDecls   = instDecls
                     , InstAST.moduleInsts = instInsts
                     }
@@ -194,8 +197,8 @@ instance Instantiatable CheckAST.ModuleInst [InstAST.ModuleInst] where
                     , varValues   = Map.empty
                     }
         lift $ checkSelfInst modPath instName
-        lift $ checkDuplicates name (DuplicateInMap  instName) $ map fst instInMap
-        lift $ checkDuplicates name (DuplicateOutMap instName) $ map fst instOutMap
+        lift $ checkDuplicates (head modPath) (DuplicateInMap  instName) $ map fst instInMap
+        lift $ checkDuplicates (head modPath) (DuplicateOutMap instName) $ map fst instOutMap
         let instantiated = InstAST.ModuleInst
                 { InstAST.moduleName = instName
                 , InstAST.namespace  = instNs
@@ -217,7 +220,7 @@ instance Instantiatable CheckAST.ModuleInst [InstAST.ModuleInst] where
             checkSelfInst path name = do
                 case loop path of
                     [] -> return ()
-                    l  -> failCheck "" $ ModuleInstLoop (reverse $ name:l)
+                    l  -> failCheck "@all" $ ModuleInstLoop (reverse $ name:l)
                     where
                         loop [] = []
                         loop path@(p:ps)
@@ -378,7 +381,6 @@ instance Instantiatable CheckAST.ForLimit Integer where
 instance (Traversable t, Instantiatable a b) => Instantiatable (t a) (t b) where
     instantiate context ast = mapM (instantiate context) ast
 
-
 getModule :: Context -> String -> CheckAST.Module
 getModule context name = (modules context) Map.! name