3 Parser.hs: Parser for the Flounder interface definition language
5 Part of Flounder: a strawman device definition DSL for Barrelfish
7 Copyright (c) 2009, ETH Zurich.
11 This file is distributed under the terms in the attached LICENSE file.
12 If you do not find this file, copies can be found by writing to:
13 ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
21 import Text.ParserCombinators.Parsec as Parsec
22 import Text.ParserCombinators.Parsec.Expr
23 import Text.ParserCombinators.Parsec.Pos
24 import qualified Text.ParserCombinators.Parsec.Token as P
25 import Text.ParserCombinators.Parsec.Language( javaStyle )
31 parse_intf predefDecls filename = parseFromFile (intffile predefDecls) filename
32 parse_include predefDecls filename = parseFromFile (includefile predefDecls) filename
34 lexer = P.makeTokenParser (javaStyle
35 { P.reservedNames = [ "interface",
41 , P.reservedOpNames = ["*","/","+","-"]
42 , P.commentStart = "/*"
46 whiteSpace = P.whiteSpace lexer
47 reserved = P.reserved lexer
48 identifier = P.identifier lexer
49 stringLit = P.stringLiteral lexer
51 commaSep = P.commaSep lexer
52 commaSep1 = P.commaSep1 lexer
53 parens = P.parens lexer
54 braces = P.braces lexer
55 squares = P.squares lexer
56 semiSep = P.semiSep lexer
57 symbol = P.symbol lexer
58 natural = P.natural lexer
60 builtinTypes = map show [UInt8 ..] ++ ["int"] -- int is legacy -AB
62 -- identifyBuiltin :: [(String, Declaration)] -> String -> TypeRef
63 identifyBuiltin typeDcls typeName =
65 if typeName `elem` builtinTypes then
66 return $ Builtin $ (read typeName::TypeBuiltin)
68 case typeName `lookup` typeDcls of
69 Just (Typedef (TAliasT new orig)) -> return $ TypeAlias new orig
70 Just _ -> return $ TypeVar typeName
74 -- This is ugly, I agree:
75 ; return $ error ("Use of undeclared type '" ++ typeName ++ "' in "
76 ++ show (sourceName pos) ++ " at l. "
77 ++ show (sourceLine pos) ++ " col. "
78 ++ show (sourceColumn pos))
82 intffile predefDecls = do { whiteSpace
83 ; i <- iface predefDecls
87 includefile predefDecls = do { whiteSpace
88 ; typeDecls <- typeDeclaration predefDecls
92 iface predefDecls = do { reserved "interface"
94 ; descr <- option name stringLit
95 ; decls <- braces $ do {
96 ; typeDecls <- typeDeclaration predefDecls
97 ; msgDecls <- many1 $ mesg typeDecls
98 ; return ((map snd typeDecls) ++ msgDecls)
100 ; symbol ";" <?> " ';' missing from end of " ++ name ++ " interface specification"
101 ; return (Interface name (Just descr) decls)
105 typeDeclaration typeDcls = do {
107 ; x <- transparentAlias
111 ; x <- typedefinition typeDcls
116 Nothing -> return typeDcls
117 Just x -> typeDeclaration (x : typeDcls)
120 mesg typeDcls = do { bckArgs <- many backendParams
121 ; def <- msg typeDcls bckArgs <|> rpc typeDcls bckArgs
122 ; return $ Messagedef def
125 msg typeDcls bckArgs = do { t <- msgtype
127 ; a <- parens $ commaSep (marg typeDcls)
129 ; return $ Message t i a bckArgs
132 rpc typeDcls bckArgs= do { _ <- rpctype
134 ; a <- parens $ commaSep (rpcArg typeDcls)
136 ; return $ RPC i a bckArgs
139 rpctype = do { reserved "rpc"
142 rpcArg typeDcls = do { reserved "in"
143 ; Arg b n <- marg typeDcls
144 ; return $ RPCArgIn b n
146 <|> do { reserved "out"
147 ; Arg b n <- marg typeDcls
148 ; return $ RPCArgOut b n
151 backendParams = do { char '@'
153 ; p <- parens $ commaSep backendParam
157 backendParam = do { name <- identifier
159 ; do { num <- natural ; return $ (name, BackendInt num) }
160 <|> do { arg <- identifier ; return $ (name, BackendMsgArg arg) }
163 msgtype = do { reserved "message"; return MMessage }
164 <|> do { reserved "call"; return MCall }
165 <|> do { reserved "response"; return MResponse }
167 marg typeDcls = try (marg_array typeDcls)
168 <|> (marg_simple typeDcls)
170 marg_simple typeDcls = do { t <- identifier
172 ; b <- identifyBuiltin typeDcls t
173 ; return (Arg b (Name n))
176 marg_array typeDcls = do { t <- identifier
181 ; bType <- identifyBuiltin typeDcls t
182 ; return (Arg bType (DynamicArray n l))
185 transparentAlias = do { whiteSpace
187 ; newType <- identifier
188 ; originType <- identifier
190 ; return (newType, Typedef $ TAliasT newType
191 (read originType::TypeBuiltin))
194 typedefinition typeDcls = do { whiteSpace
196 ; (name, typeDef) <- typedef_body typeDcls
198 ; return (name, Typedef typeDef)
201 typedef_body typeDcls = try (struct_typedef typeDcls)
202 <|> try (array_typedef typeDcls)
204 <|> (alias_typedef typeDcls)
206 struct_typedef typeDcls = do { reserved "struct"
207 ; f <- braces $ many1 (struct_field typeDcls)
209 ; return (i, (TStruct i f))
212 struct_field typeDcls = do { t <- identifier
215 ; b <- identifyBuiltin typeDcls t
216 ; return (TStructField b i)
219 array_typedef typeDcls = do { t <- identifier
224 ; b <- identifyBuiltin typeDcls t
225 ; return (i, (TArray b i sz))
228 enum_typedef = do { reserved "enum"
229 ; v <- braces $ commaSep1 identifier
231 ; return (i, (TEnum i v))
234 alias_typedef typeDcls = do { t <- identifier
236 ; b <- identifyBuiltin typeDcls t
237 ; return (i, (TAlias i b))
240 integer = P.integer lexer