Sockeye: Start implementation of checker
[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 {-# LANGUAGE MultiParamTypeClasses #-}
17 {-# LANGUAGE FlexibleContexts #-}
18
19 module SockeyeChecker
20 ( checkSockeye ) where
21
22 import Control.Monad (join)
23
24 import Data.List (nub)
25 import Data.Map (Map)
26 import qualified Data.Map as Map
27 import Data.Set (Set)
28 import qualified Data.Set as Set
29 import Data.Either
30
31 import qualified SockeyeASTFrontend as ASTF
32 import qualified SockeyeASTIntermediate as ASTI
33
34 data FailedCheck
35     = DuplicateModule String
36     | DuplicateParameter String
37     | DuplicateVariable String
38
39 instance Show FailedCheck where
40     show (DuplicateModule name)    = "Duplicate module '" ++ name ++ "'"
41     show (DuplicateParameter name) = "Duplicate parameter '" ++ name ++ "'"
42     show (DuplicateVariable name)  = "Duplicate variable '" ++ name ++ "'"
43
44 newtype CheckFailure = CheckFailure
45     { failedChecks :: [FailedCheck] }
46
47 instance Show CheckFailure where
48     show (CheckFailure fs) = unlines $ map (("    " ++) . show) fs
49
50 checkSockeye :: ASTF.SockeyeSpec -> Either CheckFailure ASTI.SockeyeSpec
51 checkSockeye ast = do
52     duplicateFree <- transform ast
53     return duplicateFree
54 -- build symbol table
55 -- check modules / top level namespace
56 --  - no duplicate identifiers
57 --  - no duplicate namespaces
58 --  - all instantiated modules must exist
59 --  - all nodes in maps / overlays must exist
60 --  - all input ports must be specified
61 --  - 
62
63 -- checkModules :: ASTF.SockeyeSpec -> ASTI.SockeyeSpec -> Either CheckFailure ASTI.SockeyeSpec
64
65 class ASTTransformable a b where
66     transform :: a -> Either CheckFailure b
67 --
68 -- Frontend AST -> Intermediate AST
69 --
70 instance ASTTransformable ASTF.SockeyeSpec ASTI.SockeyeSpec where
71     transform ast = do
72         let
73             modules = rootModule:(ASTF.modules ast)
74             names = map ASTF.name modules
75         checkDuplicates names DuplicateModule
76         transformed <- checkAll transform modules
77         let
78             moduleMap = Map.fromList $ zip names transformed
79         return ASTI.SockeyeSpec
80                 { ASTI.modules = moduleMap }
81         where
82             rootModule =
83                 let
84                     body = ASTF.ModuleBody
85                         { ASTF.ports = []
86                         , ASTF.moduleNet = ASTF.net ast
87                         }
88                 in ASTF.Module
89                     { ASTF.name       = "@root"
90                     , ASTF.parameters = []
91                     , ASTF.moduleBody = body
92                     }   
93
94 instance ASTTransformable ASTF.Module ASTI.Module where
95     transform ast = do
96         let
97             paramNames = map ASTF.paramName (ASTF.parameters ast)
98             paramTypes = map ASTF.paramType (ASTF.parameters ast)
99         checkDuplicates paramNames DuplicateParameter
100         let
101             portDefs = ASTF.ports $ ASTF.moduleBody ast
102         inputPorts <- checkAll transform $ filter isInPort portDefs
103         outputPorts <- checkAll transform $ filter (not . isInPort) portDefs
104         let
105             paramTypeMap = Map.fromList $ zip paramNames paramTypes
106         return ASTI.Module
107             { ASTI.paramNames  = paramNames
108             , ASTI.paramTypes  = paramTypeMap
109             , ASTI.inputPorts  = inputPorts
110             , ASTI.outputPorts = outputPorts
111             , ASTI.nodeDecls   = []
112             , ASTI.moduleInsts = []
113             }
114         where
115             isInPort (ASTF.InputPortDef _) = True
116             isInPort (ASTF.OutputPortDef _) = False
117             isInPort (ASTF.MultiPortDef for) = isInPort $ ASTF.body for
118
119 instance ASTTransformable ASTF.PortDef ASTI.Port where
120     transform (ASTF.InputPortDef ident) = return $ ASTI.Port ident
121     transform (ASTF.OutputPortDef ident) = return $ ASTI.Port ident
122     transform (ASTF.MultiPortDef for) = do
123         transformed <- transform for
124         return $ ASTI.MultiPort transformed
125
126 instance ASTTransformable a b => ASTTransformable (ASTF.For a) (ASTI.For b) where
127     transform ast = do
128         let
129             vars = map ASTF.var (ASTF.varRanges ast)
130         checkDuplicates vars DuplicateVariable
131         ranges <- checkAll transform (ASTF.varRanges ast)
132         body <- transform $ ASTF.body ast
133         let
134             varRanges = Map.fromList $ zip vars ranges
135         return ASTI.For
136                 { ASTI.varRanges = varRanges
137                 , ASTI.body      = body
138                 }
139
140 instance ASTTransformable ASTF.ForVarRange ASTI.ForRange where
141     transform ast = do
142         let
143             start = ASTF.start ast
144             end = ASTF.end ast
145         return ASTI.ForRange
146             { ASTI.start = start
147             , ASTI.end   = end
148             }
149
150 checkDuplicates :: [String] -> (String -> FailedCheck) -> Either CheckFailure ()
151 checkDuplicates names failure = do
152     let
153         duplicates = duplicateNames names
154     case duplicates of
155         [] -> return ()
156         _  -> Left $ CheckFailure (map failure duplicates)
157     where
158         duplicateNames [] = []
159         duplicateNames (x:xs)
160             | x `elem` xs = nub $ [x] ++ duplicateNames xs
161             | otherwise = duplicateNames xs  
162
163 checkAll :: (a -> Either CheckFailure b) -> [a] -> Either CheckFailure [b]
164 checkAll f as = do
165     let
166         bs = map f as
167         es = concat $ map failedChecks (lefts bs)
168     case es of
169         [] -> return $ rights bs
170         _  -> Left $ CheckFailure es