Make Sockeye case sensitive again
[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 import Data.Char (toLower)
27
28 import qualified SockeyeAST as AST
29
30 type CheckFailure = (Maybe AST.NodeId, String)
31
32 canonicalId :: AST.NodeId -> AST.NodeId
33 canonicalId = id
34
35 findUniqueIdentifiers :: AST.NetSpec -> Writer [CheckFailure] (Set AST.NodeId)
36 findUniqueIdentifiers (AST.NetSpec nodes) = let allIds = map fst $ nodes
37                                             in foldl checkAndAdd (return Set.empty) allIds
38                                             where checkAndAdd w id = do
39                                                     let cId = canonicalId id
40                                                     uids <- w
41                                                     tell $ if cId `Set.member` uids then
42                                                             [(Nothing, "Duplicate identifier '" ++ show id ++ "'")]
43                                                            else
44                                                             []
45                                                     return $ cId `Set.insert` uids
46
47 class Checkable a where
48     checkReferences :: (Set AST.NodeId) -> a -> Writer [CheckFailure] Bool
49
50 instance Checkable AST.NetSpec where
51     checkReferences ids (AST.NetSpec nodes) = do
52         foldM (checkNode) False nodes
53         where checkNode prevError (nodeId, node) = prependId nodeId $ runWriter $ do
54                 (hasError, errors) <- listen $ checkReferences ids node
55                 return $ hasError || prevError
56               prependId nodeId (hasError, errors) = writer (hasError, map (\(_, e) -> (Just nodeId, e)) errors)
57
58 instance Checkable AST.NodeSpec where
59     checkReferences ids nodeSpec = do
60         foldM checkMap False $ AST.translate nodeSpec
61         case AST.overlay nodeSpec of
62             Nothing -> return False
63             Just id -> do
64                 let cId  = canonicalId id
65                     undefined = cId `Set.notMember` ids
66                 tell $ if undefined then
67                         [(Nothing, "Reference to undefined node '" ++ show id ++ "' in overlay")]
68                        else
69                         []
70                 return undefined
71         where checkMap prevError mapSpec = do
72                 hasError <- checkReferences ids mapSpec
73                 return $ hasError || prevError
74
75 instance Checkable AST.MapSpec where
76     checkReferences ids mapSpec = do
77         let destNode = AST.destNode mapSpec
78             cDestNode = canonicalId destNode
79             undefined = cDestNode `Set.notMember` ids
80         tell $ if undefined then
81                 [(Nothing, "Reference to undefined node '" ++ show destNode ++ "' in map")]
82                else
83                 []
84         return undefined
85
86 {- Group the failed checks by their nodeId-}
87 group :: [CheckFailure] -> [(Maybe AST.NodeId, [String])]
88 group fs = Map.toList $ foldr addOrAppend Map.empty fs
89         where addOrAppend (key, error) m = if key `Map.member` m then
90                                                 Map.insert key (error:(m Map.! key))  m
91                                             else
92                                                 Map.insert key [error] m
93
94 checkSockeye :: AST.NetSpec -> [(Maybe AST.NodeId, [String])]
95 checkSockeye ast = group $ snd $ runWriter $ do
96     ids <- findUniqueIdentifiers ast
97     checkReferences ids ast