1{- 2 3 Parser.hs: Parser for the Flounder interface definition language 4 5 Part of Flounder: a strawman device definition DSL for Barrelfish 6 7 Copyright (c) 2009, ETH Zurich. 8 9 All rights reserved. 10 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. 14-} 15 16module Parser where 17 18import Syntax 19 20import Prelude 21import Text.ParserCombinators.Parsec as Parsec 22import Text.ParserCombinators.Parsec.Expr 23import Text.ParserCombinators.Parsec.Pos 24import qualified Text.ParserCombinators.Parsec.Token as P 25import Text.ParserCombinators.Parsec.Language( javaStyle ) 26import Data.Char 27import Numeric 28import Data.List 29import Text.Printf 30 31parse_intf predefDecls filename = parseFromFile (intffile predefDecls) filename 32parse_include predefDecls filename = parseFromFile (includefile predefDecls) filename 33 34lexer = P.makeTokenParser (javaStyle 35 { P.reservedNames = [ "interface", 36 "message", 37 "rpc", 38 "in", 39 "out" 40 ] 41 , P.reservedOpNames = ["*","/","+","-"] 42 , P.commentStart = "/*" 43 , P.commentEnd = "*/" 44 }) 45 46whiteSpace = P.whiteSpace lexer 47reserved = P.reserved lexer 48identifier = P.identifier lexer 49stringLit = P.stringLiteral lexer 50comma = P.comma lexer 51commaSep = P.commaSep lexer 52commaSep1 = P.commaSep1 lexer 53parens = P.parens lexer 54braces = P.braces lexer 55squares = P.squares lexer 56semiSep = P.semiSep lexer 57symbol = P.symbol lexer 58natural = P.natural lexer 59 60builtinTypes = map show [UInt8 ..] ++ ["errval"] ++ ["int"] -- int is legacy -AB 61 62-- identifyBuiltin :: [(String, Declaration)] -> String -> TypeRef 63identifyBuiltin typeDcls typeName = 64 do { 65 if typeName `elem` builtinTypes then 66 return $ Builtin $ (read typeName::TypeBuiltin) 67 else 68 case typeName `lookup` typeDcls of 69 Just (Typedef (TAliasT new orig)) -> return $ TypeAlias new orig 70 Just _ -> return $ TypeVar typeName 71 Nothing -> 72 do { 73 ; pos <- getPosition 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)) 79 } 80 } 81 82intffile predefDecls = do { whiteSpace 83 ; i <- iface predefDecls 84 ; return i 85 } 86 87includefile predefDecls = do { whiteSpace 88 ; typeDecls <- typeDeclaration predefDecls 89 ; return typeDecls 90 } 91 92iface predefDecls = do { reserved "interface" 93 ; name <- identifier 94 ; descr <- option name stringLit 95 ; decls <- braces $ do { 96 ; typeDecls <- typeDeclaration predefDecls 97 ; msgDecls <- many1 $ mesg typeDecls 98 ; return ((map snd typeDecls) ++ msgDecls) 99 } 100 ; symbol ";" <?> " ';' missing from end of " ++ name ++ " interface specification" 101 ; return (Interface name (Just descr) decls) 102 } 103 104 105typeDeclaration typeDcls = do { 106 ; decl <- try (do { 107 ; x <- transparentAlias 108 ; return $ Just x 109 }) 110 <|> try (do { 111 ; x <- typedefinition typeDcls 112 ; return $ Just x 113 }) 114 <|> return Nothing 115 ; case decl of 116 Nothing -> return typeDcls 117 Just x -> typeDeclaration (x : typeDcls) 118 } 119 120mesg typeDcls = do { bckArgs <- many backendParams 121 ; def <- msg typeDcls bckArgs <|> rpc typeDcls bckArgs 122 ; return $ Messagedef def 123 } 124 125msg typeDcls bckArgs = do { t <- msgtype 126 ; i <- identifier 127 ; a <- parens $ commaSep (marg typeDcls) 128 ; symbol ";" 129 ; return $ Message t i a bckArgs 130 } 131 132rpc typeDcls bckArgs= do { _ <- rpctype 133 ; i <- identifier 134 ; a <- parens $ commaSep (rpcArg typeDcls) 135 ; symbol ";" 136 ; return $ RPC i a bckArgs 137 } 138 139rpctype = do { reserved "rpc" 140 ; return () } 141 142rpcArg typeDcls = do { reserved "in" 143 ; Arg b n <- marg typeDcls 144 ; return $ RPCArgIn b n 145 } 146 <|> do { reserved "out" 147 ; Arg b n <- marg typeDcls 148 ; return $ RPCArgOut b n 149 } 150 151backendParams = do { char '@' 152 ; i <- identifier 153 ; p <- parens $ commaSep backendParam 154 ; return (i, p) 155 } 156 157backendParam = do { name <- identifier 158 ; symbol "=" 159 ; do { num <- natural ; return $ (name, BackendInt num) } 160 <|> do { arg <- identifier ; return $ (name, BackendMsgArg arg) } 161 } 162 163msgtype = do { reserved "message"; return MMessage } 164 165marg typeDcls = try (marg_array typeDcls) 166 <|> (marg_string typeDcls) 167 <|> (marg_simple typeDcls) 168 169 170marg_string typeDcls = do { symbol "String" 171 ; n <- identifier 172 ; symbol "[" 173 ; s <- natural 174 ; symbol "]" 175 ; bType <- identifyBuiltin typeDcls "String" 176 ; return (Arg bType (StringArray n s)) 177 } 178 179 180marg_simple typeDcls = do { t <- identifier 181 ; n <- identifier 182 ; b <- identifyBuiltin typeDcls t 183 ; return (Arg b (Name n)) 184 } 185 186marg_array typeDcls = do { t <- identifier 187 ; n <- identifier 188 ; symbol "[" 189 ; l <- identifier 190 ; comma 191 ; s <- natural 192 ; symbol "]" 193 ; bType <- identifyBuiltin typeDcls t 194 ; return (Arg bType (DynamicArray n l s)) 195 } 196 197transparentAlias = do { whiteSpace 198 ; reserved "alias" 199 ; newType <- identifier 200 ; originType <- identifier 201 ; symbol ";" 202 ; return (newType, Typedef $ TAliasT newType 203 (read originType::TypeBuiltin)) 204 } 205 206typedefinition typeDcls = do { whiteSpace 207 ; reserved "typedef" 208 ; (name, typeDef) <- typedef_body typeDcls 209 ; symbol ";" 210 ; return (name, Typedef typeDef) 211 } 212 213typedef_body typeDcls = try (struct_typedef typeDcls) 214 <|> try (array_typedef typeDcls) 215 <|> try enum_typedef 216 <|> (alias_typedef typeDcls) 217 218struct_typedef typeDcls = do { reserved "struct" 219 ; f <- braces $ many1 (struct_field typeDcls) 220 ; i <- identifier 221 ; return (i, (TStruct i f)) 222 } 223 224struct_field typeDcls = do { t <- identifier 225 ; i <- identifier 226 ; symbol ";" 227 ; b <- identifyBuiltin typeDcls t 228 ; return (TStructField b i) 229 } 230 231array_typedef typeDcls = do { t <- identifier 232 ; i <- identifier 233 ; symbol "[" 234 ; sz <- integer 235 ; symbol "]" 236 ; b <- identifyBuiltin typeDcls t 237 ; return (i, (TArray b i sz)) 238 } 239 240enum_typedef = do { reserved "enum" 241 ; v <- braces $ commaSep1 identifier 242 ; i <- identifier 243 ; return (i, (TEnum i v)) 244 } 245 246alias_typedef typeDcls = do { t <- identifier 247 ; i <- identifier 248 ; b <- identifyBuiltin typeDcls t 249 ; return (i, (TAlias i b)) 250 } 251 252integer = P.integer lexer 253