Rename sockey2 -> sockeye
[barrelfish] / tools / sockeye / SockeyeChecker.hs
1 {-
2   SockeyeChecker.hs: AST checker for Sockeye
3
4   Part of Sockeye
5
6   Copyright (c) 2017, ETH Zurich.
7
8   All rights reserved.
9
10   This file is distributed under the terms in the attached LICENSE file.
11   If you do not find this file, copies can be found by writing to:
12   ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
13   Attn: Systems Group.
14 -}
15
16 module SockeyeChecker
17 ( checkSockeye ) where
18
19 import Control.Monad
20 import Control.Monad.Trans.Writer
21
22 import Data.Map (Map)
23 import qualified Data.Map as Map
24 import Data.Set (Set)
25 import qualified Data.Set as Set
26
27 import qualified SockeyeAST as AST
28
29 type CheckFailure = (Maybe AST.NodeId, String)
30
31 findUniqueIdentifiers :: AST.NetSpec -> Writer [CheckFailure] (Set AST.NodeId)
32 findUniqueIdentifiers (AST.NetSpec nodes) = let allIds = map fst $ nodes
33                                             in foldl checkAndAdd (return Set.empty) allIds
34                                             where checkAndAdd w id = do
35                                                     uids <- w
36                                                     tell $ if id `Set.member` uids then
37                                                             [(Nothing, "Duplicate identifier '" ++ show id ++ "'")]
38                                                            else
39                                                             []
40                                                     return $ id `Set.insert` uids
41
42 class Checkable a where
43     checkReferences :: (Set AST.NodeId) -> a -> Writer [CheckFailure] Bool
44
45 instance Checkable AST.NetSpec where
46     checkReferences ids (AST.NetSpec nodes) = do
47         foldM (checkNode) False nodes
48         where checkNode prevError (nodeId, node) = prependId nodeId $ runWriter $ do
49                 (hasError, errors) <- listen $ checkReferences ids node
50                 return $ hasError || prevError
51               prependId nodeId (hasError, errors) = writer (hasError, map (\(_, e) -> (Just nodeId, e)) errors)
52
53 instance Checkable AST.NodeSpec where
54     checkReferences ids nodeSpec = do
55         foldM checkMap False $ AST.translate nodeSpec
56         case AST.overlay nodeSpec of
57             Nothing -> return False
58             Just id -> do
59                 let undefined = id `Set.notMember` ids
60                 tell $ if undefined then
61                         [(Nothing, "Reference to undefined node '" ++ show id ++ "' in overlay")]
62                        else
63                         []
64                 return undefined
65         where checkMap prevError mapSpec = do
66                 hasError <- checkReferences ids mapSpec
67                 return $ hasError || prevError
68
69 instance Checkable AST.MapSpec where
70     checkReferences ids mapSpec = do
71         let destNode = AST.destNode mapSpec
72             undefined = destNode `Set.notMember` ids
73         tell $ if undefined then
74                 [(Nothing, "Reference to undefined node '" ++ show destNode ++ "' in map")]
75                else
76                 []
77         return undefined
78
79 {- Group the failed checks by their nodeId-}
80 group :: [CheckFailure] -> [(Maybe AST.NodeId, [String])]
81 group fs = Map.toList $ foldr addOrAppend Map.empty fs
82         where addOrAppend (key, error) m = if key `Map.member` m then
83                                                 Map.insert key (error:(m Map.! key))  m
84                                             else
85                                                 Map.insert key [error] m
86
87 checkSockeye :: AST.NetSpec -> [(Maybe AST.NodeId, [String])]
88 checkSockeye ast = group $ snd $ runWriter $ do
89     ids <- findUniqueIdentifiers ast
90     checkReferences ids ast