/src/Cxx/Parse.hs
Haskell | 747 lines | 564 code | 116 blank | 67 comment | 25 complexity | d4541a0bedad78b3cfe915c51e6f1d0f MD5 | raw file
1{-# LANGUAGE UnicodeSyntax, ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, OverlappingInstances, GADTs, TypeOperators, TypeFamilies, PatternGuards, DeriveDataTypeable #-} 2{-# OPTIONS_GHC -O0 #-} 3 4{- C++ is notoriously hard to parse. There are ambiguities in the grammar that can only be resolved through things like name lookup, which in turn require things like overloading and template instantiation, and so one basically has to implement a complete compiler front-end just to be able to parse. 5 6However, this assumes that one insists on telling the ambiguous constructs apart. In the C++ parser defined in this module, we drop this requirement, and instead just accept that some ambiguous constructs will be parsed arbitrarily as one of their possible interpretations. This means that for something like: 7 8 x*y; 9 10we don't do name lookup to determine whether x is a type or a variable, in order to decide whether this statement is a declaration-statement or an expression-statement. We just parse it as a declaration, because we're especially interested in parsing declarations (since they have names and are natural subjects of edit commands). 11 12Here are some more typical ambiguous constructs: 13 14 int x(y); // If y is a type, this is a function declaration. Otherwise, it's a variable definition. 15 x<y> z; // If x is a template, this is a variable declaration. Otherwise, it's an expression-statement. 16 x(y); // If x is a type, this is a variable declaration. Otherwise, it's a function call. 17 x+(y)(z); // if y is a type, (y)(z) is a cast. Otherwise, it's a function call. 18 19We always prefer parsing things as declarations. 20 21Note that even if we /could/ parse properly with name lookup and all the rest, we wouldn't want to, because we typically want to parse ill-formed code (with type errors, for example) in order to run edit commands on it to make it well-formed. 22 23This C++ parser is probably extremely inefficient. Fortunately, geordi only ever runs it on tiny C++ snippets, so we just don't care. 24 25-} 26 27module Cxx.Parse (Chunk(..), code, charLit, stringLit, makeType, precedence, parseRequest, makeDeclParser, declaratorIdParser, highlight) where 28 29import qualified Data.Char as Char 30import qualified Data.List as List 31import qualified Data.List.NonEmpty as NeList 32import qualified Parsers as P 33import qualified Cxx.Show 34import Control.Arrow (first, second) 35import Control.Applicative (Applicative(..)) 36import Control.Monad.Fix (fix) 37import Control.Monad.Instances () 38import Control.Monad (liftM2, liftM3, when) 39import Data.List ((\\)) 40import Data.List.NonEmpty (NonEmpty(..)) 41import Data.Generics (Data, Typeable, dataTypeOf) 42import Data.Maybe (mapMaybe) 43import Data.Function (on) 44import Data.Foldable (toList) 45import Util ((<<), (.), Convert(..), isIdChar, Finite(..), Phantom(..), cardinals, partitionMaybe, TriBool(..), (.∨.), NeList, neElim, prefixNeList, neInitLast) 46import Cxx.Basics 47import Cxx.Show (pretty_with_precedence, Highlighter) 48import Cxx.Operations (apply, squared, is_primary_TypeSpecifier, parenthesized, specT, split_all_decls, is_pointer_or_reference) 49import Prelude hiding ((.)) 50import Prelude.Unicode 51import Control.Monad.Reader (ReaderT(..)) 52import Parsers ((<?>), (<|>), pzero, spaces, many, optional, choice, sep, many1, symbols, noneOf, lookAhead, symbol, satisfy, optionMaybe, anySymbol, manyTill, many1Till, oneOf, ParserLike, eof, ParseResult(..), getInput, sepBy1, option) 53import MemoTrie (memo, Trie(..), PairTrie(..), BoolTrie(..)) 54 55-- Custom parsing monad: 56 57data ParseOptions = ParseOptions { makeTypeExtensions :: Bool, pendingCloseAngleBracket :: Bool } 58 59instance Trie ParseOptions (PairTrie BoolTrie BoolTrie) where 60 trie f = trie (\(x, y) → f $ ParseOptions x y) 61 untrie f (ParseOptions x y) = untrie f (x, y) 62 63defaultParseOptions :: ParseOptions 64defaultParseOptions = ParseOptions { makeTypeExtensions = False, pendingCloseAngleBracket = False } 65 66type Parser t = ReaderT ParseOptions (P.Parser t) 67 68instance ParserLike (Parser a) a where 69 anySymbol = ReaderT $ const anySymbol 70 eof = ReaderT $ const eof 71 pzero = ReaderT $ const pzero 72 ReaderT p <?> s = ReaderT $ (<?> s) . p 73 ReaderT p <|> ReaderT q = ReaderT $ \o → p o <|> q o 74 symbols = ReaderT . const . symbols 75 satisfy = ReaderT . const . satisfy 76 lookAhead (ReaderT p) = ReaderT $ lookAhead . p 77 try = id 78 79parseOptions :: Parser t ParseOptions 80parseOptions = ReaderT return 81 82-- Some combinators: 83 84silent :: Parser a b → Parser a b 85silent (ReaderT f) = ReaderT $ P.silent . f 86 87guarded :: (a → Bool) → Parser t a → Parser t a 88guarded f (ReaderT p) = ReaderT $ P.guarded f . p 89 90memoize :: Parser Char a → Parser Char a 91memoize (ReaderT p) = ReaderT $ \o → P.Parser $ \s → m (o, s) 92 where m = memo $ \(o, s) → P.run_parser (p o) s 93 -- Note that we memoize over the whole input string, rather than just the position. This is very simplistic and inefficient, but we don't care. We only use memoization to prevent exponential explosions. 94 95notFollowedBy :: Parser t a → Parser t () 96notFollowedBy (ReaderT p) = ReaderT $ P.notFollowedBy . p 97 98-- Primary module exports 99 100precedence :: String → Either String String 101precedence s = either (pretty_with_precedence . split_all_decls) (pretty_with_precedence . split_all_decls) . 102 P.parseOrFail p (dropWhile Char.isSpace s) "code" 103 where p = runReaderT (parse << eof) defaultParseOptions :: P.Parser Char (Either Expression [Statement]) 104 105highlight :: Highlighter → String → String 106highlight h s = 107 case P.run_parser p (dropWhile Char.isSpace s) of 108 ParseSuccess r _ _ _ → Cxx.Show.show_pretty False h r 109 ParseFailure{} → s 110 where p = runReaderT (parse << eof) defaultParseOptions :: P.Parser Char GeordiRequest 111 112parseRequest :: String → Either String GeordiRequest 113parseRequest s = P.parseOrFail (runReaderT (parse << eof) defaultParseOptions) s "request" 114 115makeType :: String → Either String TypeId 116makeType s = P.parseOrFail (runReaderT (parse << eof) (defaultParseOptions { makeTypeExtensions = True })) (dropWhile Char.isSpace s) "type description" 117 118-- Chunk/Code parsers 119 120textLit :: ParserLike m Char ⇒ Char → m String 121textLit q = (symbol q >>) $ fix $ \h → do 122 s ← many $ noneOf [q, '\\'] 123 c ← anySymbol 124 if c == '\\' 125 then do d ← anySymbol; r ← h; return $ s ++ ('\\':d:r) 126 else return s 127 128rawStringLit :: ParserLike m Char ⇒ m Chunk 129rawStringLit = do 130 symbols "R\"" 131 x <- fst . (anySymbol `manyTill` symbol '(') 132 y <- fst . (anySymbol `manyTill` P.try (symbols (')' : x) >> symbol '"')) 133 return $ RawStringLiteral x y 134 135-- Parsec's Haskell char/string literal parsers consume whitespace, and save the value rather than the denotation. 136 137charLit, stringLit, digits, plain, parens, curlies, squares, multiComment, singleComment :: ParserLike m Char ⇒ m Chunk 138 139charLit = CharLiteral . textLit '\'' 140stringLit = StringLiteral' . textLit '"' 141digits = Plain . (liftM2 (:) (satisfy Char.isDigit) (many (satisfy (\c -> Char.isDigit c || c == '\'')))) 142plain = Plain . ((:[]) . oneOf ";\\" <|> toList . many1 punct <|> toList . many1 (satisfy Char.isAlpha)) 143 where 144 punct = do 145 c <- satisfy (\c -> not (Char.isAlphaNum c) && not (c `elem` "'\"{([])};\\")) 146 when (c == '/') $ lookAhead (noneOf "*/") >> return () 147 return c 148parens = Parens . (symbol '(' >> code << symbol ')') 149curlies = Curlies . (symbol '{' >> code << symbol '}') 150squares = Squares . (symbol '[' >> code << symbol ']') 151multiComment = MultiComment . (symbols "/*" >> fst . manyTill anySymbol (symbols "*/")) 152singleComment = SingleComment . (symbols "//" >> many (noneOf "\\")) 153 154code :: ParserLike m Char ⇒ m Code 155code = many $ (<?> "balanced code") $ 156 multiComment <|> singleComment <|> charLit <|> parens <|> curlies <|> squares 157 <|> stringLit <|> rawStringLit <|> digits <|> plain 158 -- Uncovers just enough structure for Request.hs to find the split positions in "<< ...; ..." and "{ ... } ..." requests and to implement --resume. 159 160-- Misc parsers. 161 162kwd :: String → Parser Char White 163kwd x = symbols x >> notFollowedBy (satisfy isIdChar) >> parse 164 165makeDeclParser :: P.Parser Char MakeDeclaration 166makeDeclParser = runReaderT parse (defaultParseOptions { makeTypeExtensions = True }) 167 168declaratorIdParser :: P.Parser Char DeclaratorId 169declaratorIdParser = runReaderT parse defaultParseOptions 170 171anyOperator :: Parser Char (OperatorTok, White) 172anyOperator = (<?> "operator") $ do 173 o ← parseOptions 174 liftM2 (,) (choice $ if pendingCloseAngleBracket o then pcab else normal) parse 175 where 176 normal = map (\x → symbols (show x) >> return x) $ List.sortBy (flip compare `on` length . show) (all_values :: [OperatorTok]) 177 pcab = map (\x → symbols (show x) >> return x) $ List.sortBy (flip compare `on` length . show) $ (all_values :: [OperatorTok]) \\ [CloseTwoAngles, CloseAngle] 178 -- Profiling showed that having these two separate makes a huge difference in space/time efficiency. 179 180op :: OperatorTok → Parser Char White 181op o = (<?> operatorTokName o) $ snd . guarded ((== o) . fst) anyOperator 182 183class Data a ⇒ Parse a where 184 parse :: Parser Char a 185 parse = autoname_parse <?> Cxx.Show.dataType_productionName (dataTypeOf (undefined :: a)) 186 autoname_parse :: Parser Char a 187 autoname_parse = parse 188 -- autoname_parse must never be used--it is merely a hook for parse. 189 190instance (Data a, Finite a, SingleTokenType a) ⇒ Parse (a, White) where parse = (<?> token_class_name (Phantom :: Phantom a)) $ choice $ (\v → (,) v . either kwd op (token v)) . all_values 191instance Parse White where 192 parse = silent $ White . concat . many ( 193 (symbols "/*" >> ("/*" ++) . (++ "*/") . fst . manyTill anySymbol (symbols "*/")) <|> 194 (symbols "//" >> ("//" ++) . getInput) <|> symbols " ") 195 196instance Parse a ⇒ Parse [a] where parse = many parse 197instance Parse a ⇒ Parse (Maybe a) where parse = optionMaybe parse 198instance Parse a ⇒ Parse (Enclosed a) where parse = Enclosed . parse 199instance (Parse a, Parse b) ⇒ Parse (a, b) where parse = auto2 (,) 200instance (Parse a, Parse b, Parse c) ⇒ Parse (a, b, c) where parse = auto3 (,,) 201instance (Parse a, Parse b, Parse c, Parse d) ⇒ Parse (a, b, c ,d) where parse = auto4 (,,,) 202instance Parse a ⇒ Parse (Commad a) where parse = liftM2 Commad parse (many (liftM2 (,) parse parse)) 203instance (Parse a, Parse b) ⇒ Parse (Either a b) where parse = Left . parse <|> Right . parse 204instance Parse a ⇒ Parse (Angled a) where parse = liftM3 Angled parse (ReaderT $ \o → runReaderT parse (o { pendingCloseAngleBracket = True })) (liftM2 (,) (symbol '>' >> return CloseAngle_) parse) 205instance Parse a ⇒ Parse (Squared a) where parse = liftM3 Squared parse (ReaderT $ \o → runReaderT parse $ o { pendingCloseAngleBracket = False }) parse 206instance Parse a ⇒ Parse (Curlied a) where parse = liftM3 Curlied parse (ReaderT $ \o → runReaderT parse $ o { pendingCloseAngleBracket = False }) parse 207instance Parse a ⇒ Parse (Parenthesized a) where parse = parseParenthesized parse 208instance Parse () where parse = return () 209instance Parse a ⇒ Parse (NeList a) where parse = many1 parse 210 211parseParenthesized :: Parser Char (Enclosed a) → Parser Char (Parenthesized a) 212parseParenthesized p = liftM3 Parenthesized parse (ReaderT $ \o → runReaderT p $ o { pendingCloseAngleBracket = False }) parse 213 214an :: Parser Char (Maybe White) 215an = silent $ optional $ kwd "an" <|> kwd "a" 216 217pluralP :: String → Parser Char () 218pluralP s = (>> return ()) $ kwd s <|> kwd (s ++ "s") 219 220delim :: Parser Char () 221delim = (op CommaTok >> optional (kwd "and") >> return ()) <|> (kwd "and" >> return ()) 222 223takingP :: Parser Char ParameterDeclarationClause 224takingP = 225 ((kwd "nothing" <|> (kwd "no" >> kwd "arguments")) >> return (ParameterDeclarationClause Nothing Nothing)) <|> mkParameterDeclarationClause . concat . sepBy1 takingClause (delim >> ((kwd "returning" >> pzero) <|> return ())) 226 227commad :: NeList x → Commad x 228commad l = Commad (NeList.head l) $ (,) (CommaOp, White " ") . NeList.tail l 229 230mkParameterDeclarationClause :: [ParameterDeclaration] → ParameterDeclarationClause 231mkParameterDeclarationClause l = 232 ParameterDeclarationClause (case l of [] → Nothing; h:t → (Just $ ParameterDeclarationList $ commad $ h :| t)) Nothing 233 234instance Parse (CvQualifier, White) where 235 parse = (<?> "cv-qualifier") $ do 236 b ← makeTypeExtensions . parseOptions 237 (if b then (,) Const . kwd "constant" else pzero) <|> (,) Const . kwd "const" <|> (,) Volatile . kwd "volatile" 238 239instance Parse CvQualifierSeq where autoname_parse = auto1 CvQualifierSeq 240 241takingClause :: Parser Char [ParameterDeclaration] 242takingClause = (do 243 IntegerLiteral s ← parse 244 let (n :: Integer) = read s 245 if n > 10 then pzero else replicate (fromInteger n) . parse) <|> (:[]) . (an >> parse) 246 247instance Parse MakeDeclaration where 248 parse = (<?> "type description") $ (an >>) $ (longlong .) $ flip fix [] $ \self specs → do 249 pspec ← parsePrimarySpec 250 sspecs ← many parseSecondarySpec 251 (\x → MakeDeclaration (reverse specs ++ pspec : sspecs) x Indeterminate) . parse 252 <|> (((: specs) . parseSecondarySpec) >>= self) 253 <|> do 254 kwd "pure" 255 let virtSpec = MakeSpecifier_DeclSpecifier $ DeclSpecifier_FunctionSpecifier (Virtual, White " ") 256 do { MakeDeclaration l m _ ← self specs; return $ MakeDeclaration (virtSpec : l) m Definitely } <|> return (MakeDeclaration (virtSpec : specs) Nothing Definitely) 257 <|> do 258 kwd "impure" <|> kwd "nonpure" 259 do { MakeDeclaration l m _ ← self specs; return $ MakeDeclaration l m DefinitelyNot } <|> return (MakeDeclaration specs Nothing DefinitelyNot) 260 <|> do 261 let (noncvs, cvs) = partitionMaybe (convert :: MakeSpecifier → Maybe (CvQualifier, White)) specs 262 (x, y) ← type_desc 263 return $ (\(p, q) → MakeDeclaration p q Indeterminate) $ apply (map fst cvs) $ case y of 264 Left s → (noncvs ++ MakeSpecifier_DeclSpecifier . DeclSpecifier_TypeSpecifier . (x ++ [s]), Nothing) 265 Right ad → (noncvs ++ MakeSpecifier_DeclSpecifier . DeclSpecifier_TypeSpecifier . x, Just ad) 266 <|> (\x → MakeDeclaration specs x Indeterminate) . (if null specs then Just . parse else parse) 267 where 268 longlong m@(MakeDeclaration l x y) 269 | (p, q) ← List.partition (== convert LongSpec) l, length p ≥ 2 = MakeDeclaration (LongLong : q) x y 270 | otherwise = m 271 272literalArrayBound :: IntegerLiteral → ConstantExpression 273literalArrayBound = ConstantExpression . ConditionalExpression_LogicalOrExpression . LogicalOrExpression_LogicalAndExpression . LogicalAndExpression_InclusiveOrExpression . InclusiveOrExpression_ExclusiveOrExpression . ExclusiveOrExpression_AndExpression . AndExpression_EqualityExpression . EqualityExpression_RelationalExpression . RelationalExpression_ShiftExpression . ShiftExpression_AdditiveExpression . AdditiveExpression_MultiplicativeExpression . MultiplicativeExpression_PmExpression . PmExpression_CastExpression . CastExpression_UnaryExpression . UnaryExpression_PostfixExpression . PostfixExpression_PrimaryExpression . PrimaryExpression_Literal . flip Literal_IntegerLiteral (White "") 274 275type_desc :: Parser Char ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator) 276 -- Todo: Document this type 277type_desc = (<?> "type description") $ do 278 o ← (pluralP "pointer" >> return (PtrOperator_Ptr (StarOperator, White "") Nothing)) 279 <|> (\k → PtrOperator_Ref (k, White "")) . (((kwd "rvalue" >> return Rvalue) <|> (optional (kwd "lvalue") >> return Lvalue)) << pluralP "reference") 280 (kwd "to" >> an >> second Right . apply o . specdDesc) <|> ((,) [] . Right . flip apply (PtrAbstractDeclarator o Nothing) . (parse :: Parser Char (Maybe PtrAbstractDeclarator))) 281 <|> do 282 pluralP "array" 283 let d = PtrAbstractDeclarator_NoptrAbstractDeclarator . NoptrAbstractDeclarator Nothing . Right . squared 284 do 285 kwd "of"; n ← ((d . Just . literalArrayBound . parse) << spaces) <|> return (d Nothing) 286 second Right . apply n . specdDesc 287 <|> do 288 mad ← parse :: Parser Char (Maybe PtrAbstractDeclarator) 289 return ([], Right $ apply mad (d Nothing)) 290 <|> liftM2 (flip apply) (op OpenParen >> specdDesc << op CloseParen) (parse :: Parser Char (Maybe PtrAbstractDeclarator)) 291 <|> do 292 pluralP "function" 293 let function_declarator taking = PtrAbstractDeclarator_NoptrAbstractDeclarator $ NoptrAbstractDeclarator Nothing (Left $ ParametersAndQualifiers (parenthesized taking) Nothing Nothing Nothing) 294 do 295 taking ← kwd "taking" >> takingP 296 do 297 second Right . apply (function_declarator taking) . (optional delim >> kwd "returning" >> an >> specdDesc) <|> return ([], Right $ function_declarator taking) 298 <|> do 299 second Right . liftM2 (flip apply) (kwd "returning" >> an >> specdDesc) (function_declarator . ((optional delim >> kwd "taking" >> takingP) <|> return (mkParameterDeclarationClause []))) 300 <|> do 301 (,) [] . Right . flip apply (function_declarator $ mkParameterDeclarationClause []) . (parse :: Parser Char (Maybe PtrAbstractDeclarator)) 302 where 303 specdDesc :: Parser Char ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator) 304 specdDesc = (<?> "type description") $ flip fix [] $ \self specs → do 305 morespecs ← liftM2 (:|) parsePrimarySpec (many parseSecondarySpec) 306 let ne = prefixNeList specs morespecs 307 mad ← parse :: Parser Char (Maybe PtrAbstractDeclarator) 308 return $ case mad of 309 Nothing → second Left $ neInitLast ne 310 Just ad → (toList ne, Right ad) 311 <|> do 312 sspec ← parseSecondarySpec 313 self (specs ++ [sspec]) <|> return ([], Left sspec) 314 <|> do 315 let (noncvs, cvs) = partitionMaybe (convert :: TypeSpecifier → Maybe (CvQualifier, White)) specs 316 first (noncvs ++) . apply (map fst cvs) . type_desc 317 318with_default :: [TypeSpecifier] → NeList TypeSpecifier 319with_default [] = return specT 320with_default l@(h:t) = if any is_primary_TypeSpecifier l then h :| t else specT :| l 321 322instance Parse GeordiRequestWithoutWhite where 323 parse = auto3 GeordiRequest_Print <|> auto2 GeordiRequest_Block <|> auto1 GeordiRequest_TU <|> auto2 GeordiRequest_Call 324 325parseAnyMixOf :: Parser t a → Parser t b → Parser t (AnyMixOf a b) 326parseAnyMixOf p q = (p >>= \x → MixAB x . q <|> return (MixA x)) <|> (q >>= \y → MixBA y . p <|> return (MixB y)) <|> return MixNone 327 328instance (Parse a, Parse b) ⇒ Parse (AnyMixOf a b) where parse = parseAnyMixOf parse parse 329 330instance Parse OptQualified where parse = auto2 OptQualified <?> "optional qualification" 331 332auto1 :: (Parse a) ⇒ (a → b) → Parser Char b 333auto1 f = f . parse 334auto2 :: (Parse a, Parse b) ⇒ (a → b → c) → Parser Char c 335auto2 f = auto1 f <*> parse 336auto3 :: (Parse a, Parse b, Parse c) ⇒ (a → b → c → d) → Parser Char d 337auto3 f = auto2 f <*> parse 338auto4 :: (Parse a, Parse b, Parse c, Parse d) ⇒ (a → b → c → d → e) → Parser Char e 339auto4 f = auto3 f <*> parse 340auto5 :: (Parse a, Parse b, Parse c, Parse d, Parse e) ⇒ (a → b → c → d → e → f) → Parser Char f 341auto5 f = auto4 f <*> parse 342auto6 :: (Parse a, Parse b, Parse c, Parse d, Parse e, Parse f) ⇒ (a → b → c → d → e → f → g) → Parser Char g 343auto6 f = auto5 f <*> parse 344 345 346-- Parse instances for all the grammar productions. 347 348-- A.1 Keywords [gram.key] 349 350instance Parse TemplateName where autoname_parse = auto1 TemplateName 351 352-- A.2 Lexical conventions [gram.lex] 353 354instance Parse Identifier where 355 autoname_parse = do 356 b ← makeTypeExtensions . parseOptions 357 let k = keywords ++ if b then make_type_keywords else [] 358 liftM2 Identifier (guarded (not . (`elem` k)) $ liftM2 (:) (satisfy $ Char.isAlpha .∨. (== '_')) (many $ satisfy isIdChar)) parse 359 360instance Parse ClassName where autoname_parse = auto1 ClassName_TemplateId <|> auto1 ClassName_Identifier 361instance Parse TypeName where autoname_parse = auto1 TypeName_ClassName 362 363instance Parse FloatingLiteral where 364 autoname_parse = (FloatingLiteral .) $ (>++> optSuffix) $ 365 (symbols "." >++> (toList . many1 digit) >++> option "" exponentPart) <|> 366 ((toList . many1 digit) >++> ((symbols "." >++> many digit >++> option "" exponentPart >++> optSuffix) <|> exponentPart)) 367 where 368 (>++>) = liftM2 (++) 369 digit = satisfy Char.isDigit 370 optSuffix = option "" $ (:[]) . (symbol 'f' <|> symbol 'l' <|> symbol 'F' <|> symbol 'L') 371 exponentPart = (symbols "e" <|> symbols "E") >++> option "" (symbols "+" <|> symbols "-") >++> (toList . many1 digit) 372instance Parse IntegerLiteral where 373 autoname_parse = (IntegerLiteral .) $ (p <|>) $ do 374 b ← makeTypeExtensions . parseOptions 375 if b then choice $ zipWith (\n s → kwd s >> return (show n)) [0::Int ..] cardinals else pzero 376 where p = liftM2 (:) (satisfy Char.isDigit) (many (satisfy Char.isAlphaNum) << notFollowedBy (satisfy isIdChar)) 377instance Parse EncodingPrefix where 378 parse = (symbols "u8" >> return EncodingPrefix_u8) <|> (symbol 'u' >> return EncodingPrefix_u) <|> (symbol 'U' >> return EncodingPrefix_U) <|> (symbol 'L' >> return EncodingPrefix_L) 379instance Parse SingleStringLiteral where parse = liftM2 SingleStringLiteral parse (textLit '"') 380instance Parse StringLiteral where autoname_parse = StringLiteral . many1 (auto2 (,)) 381instance Parse CharacterLiteralKind where parse = (symbol 'u' >> return CharacterLiteralKind_u) <|> (symbol 'U' >> return CharacterLiteralKind_U) <|> (symbol 'L' >> return CharacterLiteralKind_L) <|> return CharacterLiteral_Plain 382instance Parse CharacterLiteral where parse = liftM2 CharacterLiteral parse (textLit '\'') 383instance Parse Literal where 384 autoname_parse = auto2 Literal_CharacterLiteral <|> auto1 Literal_StringLiteral <|> auto2 Literal_FloatingLiteral <|> auto2 Literal_IntegerLiteral <|> BooleanLiteral True . kwd "true" <|> BooleanLiteral False . kwd "false" <|> PointerLiteral . kwd "nullptr" 385 386-- A.3 Basic concepts [gram.basic] 387 388instance Parse TranslationUnit where parse = TranslationUnit . parse 389 390-- A.4 Expressions [gram.expr] 391 392instance Parse PrimaryExpression where 393 autoname_parse = 394 auto1 PrimaryExpression_This <|> auto1 PrimaryExpression_Literal <|> 395 auto1 PrimaryExpression_Expression <|> auto1 PrimaryExpression_IdExpression <|> 396 auto1 PrimaryExpression_LambdaExpression 397instance Parse IdExpression where autoname_parse = auto1 IdExpression 398instance Parse UnqualifiedId where 399 autoname_parse = 400 (parse >>= \w → (UnqualifiedId_OperatorFunctionId . OperatorFunctionId w . parse <|> UnqualifiedId_ConversionFunctionId . ConversionFunctionId w . parse)) 401 <|> auto1 UnqualifiedId_TemplateId <|> auto1 UnqualifiedId_Identifier <|> auto2 UnqualifiedId_Destructor 402instance Parse QualifiedId where 403 autoname_parse = (do 404 w ← parse 405 auto3 (NestedUnqualifiedId (Just w)) <|> GlobalIdentifier w . parse <|> GlobalOperatorFunctionId w . parse <|> GlobalTemplateId w . parse 406 ) <|> auto3 (NestedUnqualifiedId Nothing) 407instance Parse NestedNameSpecifier where 408 autoname_parse = liftM2 (foldl (flip ($))) 409 (auto2 NestedNameSpecifier_TypeName) 410 (many $ auto3 (\x y z u → NestedNameSpecifier_SimpleTemplateId u x y z) <|> auto2 (\x y z → NestedNameSpecifier_Identifier z x y)) 411 -- We can't distinguish a simple class-name from a namespace-name anyway, so we only try to parse a type-name here. 412instance Parse LambdaExpression where autoname_parse = auto3 LambdaExpression 413instance Parse LambdaIntroducer where autoname_parse = auto1 LambdaIntroducer 414instance Parse LambdaCapture where 415 autoname_parse = (do 416 def ← parse 417 let sofar = LambdaCapture (Just def) 418 m ← optionMaybe (liftM2 (,) parse parse) 419 return $ case m of 420 Just ((c,w), l) → sofar (Just (c, w)) (Just l) 421 Nothing → sofar Nothing Nothing 422 ) <|> auto1 (LambdaCapture Nothing Nothing . Just) 423instance Parse CaptureDefault where autoname_parse = auto1 CaptureDefault 424instance Parse CaptureList where autoname_parse = auto1 CaptureList 425instance Parse Capture where autoname_parse = auto2 Capture_Identifier <|> auto1 Capture_This 426instance Parse LambdaDeclarator where autoname_parse = auto4 LambdaDeclarator 427instance Parse PostfixExpression where 428 autoname_parse = liftM2 (foldl $ flip ($)) basic $ many $ (<?> "postfix operator") $ 429 auto3 (\o t e' e → PostfixExpression_Member e o t e') <|> flip PostfixExpression_IncDec . parse <|> flip PostfixExpression_FunctionCall . parse <|> flip PostfixExpression_Squared . parse <|> auto2 (\o n e → PostfixExpression_PseudoDestructor e o n) 430 where 431 basic = auto3 PostfixExpression_NewStyleCast <|> auto2 PostfixExpression_Conversion <|> auto2 PostfixExpression_TypeId <|> auto1 PostfixExpression_PrimaryExpression 432instance Parse ExpressionList where autoname_parse = auto1 ExpressionList 433instance Parse PseudoDestructorName where 434 autoname_parse = do 435 w ← parse 436 mnns ← parse 437 maybe pzero (auto5 . PseudoDestructorName_InTemplate w) mnns <|> 438 auto2 (PseudoDestructorName (OptQualified w mnns)) <|> 439 auto4 (PseudoDestructorName_InTypeName (OptQualified w mnns)) 440simpleBinaryGroup :: (Parse (b, White), Parse a) ⇒ (a1 → (b, White) → a → a1) → (a → a1) → Parser Char a1 441simpleBinaryGroup c l = do 442 (e, f) ← sep parse (parse <?> "binary operator") 443 return $ foldl (\z ((o, w), y) → c z (o, w) y) (l e) f 444simplerBinaryGroup :: (Parse a) ⇒ Parser Char d → (a1 → d → a → a1) → (a → a1) → Parser Char a1 445simplerBinaryGroup p c l = do 446 (e, f) ← sep parse (p <?> "binary operator") 447 return $ foldl (\z (w, y) → c z w y) (l e) f 448instance Parse UnaryExpression where 449 autoname_parse = 450 (parse >>= \w → (UnaryExpression_Sizeof_TypeId w . parse <|> (UnaryExpression_Sizeof_UnaryExpression w . parse))) <|> 451 auto2 UnaryExpression_AlignOf <|> auto2 UnaryExpression <|> UnaryExpression_NewExpression . parse <|> UnaryExpression_DeleteExpression . parse <|> UnaryExpression_PostfixExpression . parse 452instance Parse NewInitializer where autoname_parse = auto1 NewInitializer_ExpressionList <|> auto1 NewInitializer_BracedInitList 453instance Parse NewExpression where autoname_parse = auto5 NewExpression 454instance Parse NewPlacement where autoname_parse = auto1 NewPlacement 455instance Parse NewTypeId where autoname_parse = auto2 NewTypeId 456instance Parse NewDeclarator where autoname_parse = auto2 NewDeclarator_PtrOperator <|> auto1 NewDeclarator_NoptrNewDeclarator 457instance Parse NoptrNewDeclarator where parse = liftM2 NoptrNewDeclarator parse (reverse . parse) 458instance Parse DeleteExpression where autoname_parse = auto4 DeleteExpression 459instance Parse ThrowExpression where autoname_parse = auto2 ThrowExpression 460instance Parse CastExpression where autoname_parse = auto2 CastExpression_Cast <|> CastExpression_UnaryExpression . parse 461instance Parse PmExpression where autoname_parse = simpleBinaryGroup PmExpression PmExpression_CastExpression 462instance Parse MultiplicativeExpression where autoname_parse = simpleBinaryGroup MultiplicativeExpression MultiplicativeExpression_PmExpression 463instance Parse AdditiveExpression where autoname_parse = simpleBinaryGroup AdditiveExpression AdditiveExpression_MultiplicativeExpression 464instance Parse ShiftExpression where autoname_parse = simpleBinaryGroup ShiftExpression ShiftExpression_AdditiveExpression 465instance Parse RelationalExpression where autoname_parse = simpleBinaryGroup RelationalExpression RelationalExpression_ShiftExpression 466instance Parse EqualityExpression where autoname_parse = simpleBinaryGroup EqualityExpression EqualityExpression_RelationalExpression 467instance Parse AndExpression where autoname_parse = simplerBinaryGroup parse AndExpression AndExpression_EqualityExpression 468instance Parse ExclusiveOrExpression where autoname_parse = simplerBinaryGroup parse ExclusiveOrExpression ExclusiveOrExpression_AndExpression 469instance Parse InclusiveOrExpression where autoname_parse = simplerBinaryGroup parse InclusiveOrExpression InclusiveOrExpression_ExclusiveOrExpression 470instance Parse LogicalAndExpression where autoname_parse = simplerBinaryGroup parse LogicalAndExpression LogicalAndExpression_InclusiveOrExpression 471instance Parse LogicalOrExpression where autoname_parse = simplerBinaryGroup parse LogicalOrExpression LogicalOrExpression_LogicalAndExpression 472instance Parse ConditionalExpression where autoname_parse = ConditionalExpression_LogicalOrExpression . parse -- Todo: This is no good, I think. 473instance Parse AssignmentExpression where 474 autoname_parse = (AssignmentExpression_ThrowExpression . parse <|>) $ do 475 e ← parse 476 AssignmentExpression_ConditionalExpression . auto4 (ConditionalExpression e) <|> auto2 (AssignmentExpression e) <|> return (AssignmentExpression_ConditionalExpression $ ConditionalExpression_LogicalOrExpression e) 477instance Parse Expression where autoname_parse = simplerBinaryGroup parse Expression_Comma Expression_AssignmentExpression 478instance Parse ConstantExpression where autoname_parse = auto1 ConstantExpression 479 480-- A.5 Statements [gram.stmt] 481 482instance Parse Statement where 483 autoname_parse = auto1 Statement_CompoundStatement <|> auto1 Statement_JumpStatement <|> auto1 Statement_SelectionStatement <|> auto1 Statement_IterationStatement <|> auto1 Statement_DeclarationStatement <|> auto1 Statement_ExpressionStatement <|> auto1 Statement_TryBlock <|> auto1 Statement_Labeled 484 485instance Parse Label where parse = auto1 IdentifierLabel <|> auto2 CaseLabel <|> auto1 DefaultLabel 486instance Parse LabeledStatement where autoname_parse = auto3 LabeledStatement 487instance Parse IterationStatement where autoname_parse = auto3 WhileStatement <|> auto5 DoWhileStatement <|> auto3 ForStatement <|> auto3 RangeForStatement 488instance Parse ForInitStatement where autoname_parse = auto1 ForInitStatement_SimpleDeclaration <|> auto1 ForInitStatement_ExpressionStatement 489instance Parse ForRangeInitializer where autoname_parse = auto1 ForRangeInitializer_Expression <|> auto1 ForRangeInitializer_BracedInitList 490instance Parse ForRangeDeclaration where autoname_parse = uncurry ForRangeDeclaration . first DeclSpecifierSeq . many1Till parse parse 491instance Parse SelectionStatement where autoname_parse = auto4 IfStatement <|> auto3 SwitchStatement 492instance Parse JumpStatement where autoname_parse = auto2 BreakStatement <|> auto2 ContinueStatement <|> auto3 ReturnStatement <|> auto3 GotoStatement 493instance Parse ExpressionStatement where autoname_parse = auto2 ExpressionStatement 494instance Parse Condition where autoname_parse = auto1 Condition_Expression <|> auto3 Condition_Declaration 495instance Parse StatementSeq where autoname_parse = auto1 StatementSeq 496instance Parse CompoundStatement where autoname_parse = auto1 CompoundStatement 497instance Parse DeclarationStatement where autoname_parse = auto1 DeclarationStatement 498 499-- A.6 Declarations [gram.dcl] 500 501instance Parse DeclarationSeq where autoname_parse = auto1 DeclarationSeq 502instance Parse Declaration where autoname_parse = auto1 Declaration_BlockDeclaration <|> auto1 Declaration_FunctionDefinition <|> auto1 Declaration_ExplicitSpecialization <|> auto1 Declaration_ExplicitInstantiation <|> auto1 Declaration_LinkageSpecification <|> auto1 Declaration_NamespaceDefinition <|> auto1 Declaration_TemplateDeclaration 503instance Parse BlockDeclaration where autoname_parse = auto1 BlockDeclaration_SimpleDeclaration <|> auto1 BlockDeclaration_AsmDefinition <|> auto1 BlockDeclaration_NamespaceAliasDefinition <|> auto1 BlockDeclaration_UsingDeclaration <|> auto1 BlockDeclaration_UsingDirective <|> auto1 BlockDeclaration_StaticAssertDeclaration <|> auto1 BlockDeclaration_AliasDeclaration 504instance Parse UsingDirective where parse = auto5 UsingDirective 505instance Parse AliasDeclaration where parse = auto5 AliasDeclaration 506instance Parse StaticAssertDeclaration where parse = auto3 StaticAssertDeclaration 507instance Parse NamespaceAliasDefinition where parse = auto6 NamespaceAliasDefinition 508instance Parse NamespaceName where parse = NamespaceName_OriginalNamespaceName . OriginalNamespaceName . parse 509instance Parse AsmDefinition where parse = auto3 AsmDefinition 510 -- Things like AsmDefinition that only occur as specializations of more general productions need no expectation string. 511 512-- A simple-declaration may have no decl-specifiers, for example in "template <typename T> X(T);". However, if we just naively use manyTill, we will accidentally parse the two statements in { i; i = 0; } as declarations. We therefore first try to parse declarators valid for simple-declarations without decl-specifiers, and if that fails, we unconditionally parse at least one decl-specifier and proceed with arbitrary declarators. 513 514data SpecialNoptrDeclarator = SpecialNoptrDeclarator { specialNoptrDeclarator :: NoptrDeclarator } deriving (Data, Typeable) 515 516instance Parse SpecialNoptrDeclarator where 517 parse = auto2 $ \x y → SpecialNoptrDeclarator $ NoptrDeclarator_WithParams (NoptrDeclarator_Id x) y 518 -- Todo: This is too simplistic. It will fail to parse (obscure) things like "(X)();" and "(X());". 519 520instance Parse SimpleDeclaration where 521 parse = liftM2 (SimpleDeclaration Nothing) (Just . InitDeclaratorList . ((convert . specialNoptrDeclarator) .) . parse) parse <|> do 522 (specs, (decls, semicolon)) ← many1Till parse (liftM2 (,) parse parse) 523 return $ SimpleDeclaration (Just $ DeclSpecifierSeq specs) decls semicolon 524 525instance Parse UsingDeclaration where parse = parse >>= \w → auto5 (UsingDeclaration_Nested w) <|> auto3 (UsingDeclaration_NonNested w) 526instance Parse AlignmentSpecifier where autoname_parse = auto2 AlignmentSpecifier 527instance Parse (BasicType, White) where 528 parse = do 529 b ← makeTypeExtensions . parseOptions 530 if not b 531 then choice $ (\v → (,) v . either kwd op (token v)) . all_values 532 else choice $ map (\(v, k) → (,) v . kwd k) $ 533 ((,) Int' . ["ints", "integer", "integers"]) ++ 534 ((,) Char' . ["chars", "character", "characters"]) ++ 535 ((,) Bool' . ["bools", "boolean", "booleans"]) ++ 536 [(Float', "floats"), (Double', "doubles"), (Void, "nothing")] ++ 537 mapMaybe (\v → either (Just . (,) v) (const Nothing) (token v)) all_values 538instance Parse SimpleTypeSpecifier where 539 autoname_parse = 540 SimpleTypeSpecifier_Auto . parse <|> SimpleTypeSpecifier_BasicType . parse 541 <|> liftM2 SimpleTypeSpecifier_DeclType parse parse <|> LengthSpec . parse <|> SignSpec . parse 542 <|> do 543 w ← parse 544 (parse >>= \nns → (auto2 (SimpleTypeSpecifier_SimpleTemplateId w nns) <|> SimpleTypeSpecifier_TypeName (OptQualified w (Just nns)) . parse)) <|> SimpleTypeSpecifier_TypeName (OptQualified w Nothing) . parse 545instance Parse TypeSpecifier where 546 autoname_parse = auto1 TypeSpecifier_ClassSpecifier <|> auto1 TypeSpecifier_TrailingTypeSpecifier <|> auto1 TypeSpecifier_EnumSpecifier 547instance Parse TrailingTypeSpecifier where 548 autoname_parse = auto1 TrailingTypeSpecifier_CvQualifier <|> auto1 TrailingTypeSpecifier_SimpleTypeSpecifier <|> auto1 TrailingTypeSpecifier_TypenameSpecifier <|> auto1 TrailingTypeSpecifier_ElaboratedTypeSpecifier 549instance Parse ElaboratedTypeSpecifier where autoname_parse = auto3 ElaboratedTypeSpecifier 550instance Parse EnumHead where autoname_parse = auto3 EnumHead 551instance Parse EnumBase where autoname_parse = auto2 EnumBase 552instance Parse EnumeratorList where autoname_parse = auto1 EnumeratorList 553instance Parse EnumeratorDefinition where autoname_parse = auto2 EnumeratorDefinition 554instance Parse Enumerator where autoname_parse = auto1 Enumerator 555instance Parse EnumKey where autoname_parse = parse >>= \e → EnumKey_Class e . parse <|> EnumKey_Struct e . parse <|> return (EnumKey e) 556instance Parse NamespaceDefinition where autoname_parse = auto4 NamespaceDefinition 557instance Parse NamespaceBody where autoname_parse = auto1 NamespaceBody 558instance Parse LinkageSpecification where autoname_parse = auto3 LinkageSpecification 559instance Parse EnumSpecifier where autoname_parse = auto2 EnumSpecifier 560 561-- A.7 Declarators [gram.decl] 562 563instance Parse (RefQualifier, White) where parse = (<?> "ref-qualifier") $ ((,) Rvalue . op AmperAmper) <|> ((,) Lvalue . op Amper) 564instance Parse PtrOperator where autoname_parse = auto2 PtrOperator_Ptr <|> PtrOperator_Ref . parse <|> auto4 PtrOperator_Nested 565instance Parse PtrAbstractDeclarator where parse = auto2 PtrAbstractDeclarator <|> PtrAbstractDeclarator_NoptrAbstractDeclarator . parse 566instance Parse NoptrAbstractDeclarator where parse = liftM2 (foldl $ NoptrAbstractDeclarator . Just) ((NoptrAbstractDeclarator_PtrAbstractDeclarator . parse) <|> NoptrAbstractDeclarator Nothing . parse) (many parse) 567instance Parse AbstractDeclarator where autoname_parse = auto1 AbstractDeclarator_PtrAbstractDeclarator 568instance Parse InitializerList where autoname_parse = auto1 InitializerList 569instance Parse InitializerClause where autoname_parse = auto1 InitializerClause 570instance Parse InitDeclaratorList where autoname_parse = auto1 InitDeclaratorList 571instance Parse InitDeclarator where 572 autoname_parse = do 573 declarator ← parse 574 if is_pointer_or_reference declarator 575 then InitDeclarator declarator . optionMaybe ((<?> "initializer") $ Initializer_Parenthesized . parseParenthesized (Enclosed . ExpressionList . InitializerList . flip Commad [] . parse) <|> auto1 Initializer_BraceOrEqualInitializer) 576 else auto1 (InitDeclarator declarator) 577 578instance Parse Declarator where 579 autoname_parse = auto1 Declarator_PtrDeclarator <|> auto3 Declarator_TrailingReturnType 580instance Parse PtrDeclarator where autoname_parse = liftM2 (flip $ foldl $ flip PtrDeclarator) (reverse . parse) (PtrDeclarator_NoptrDeclarator . parse) 581 582instance Parse NoptrDeclarator where 583 parse = liftM2 (foldl f :: NoptrDeclarator -> [Either ParametersAndQualifiers (Squared (Maybe ConstantExpression))] -> NoptrDeclarator) (NoptrDeclarator_Parenthesized . parse <|> NoptrDeclarator_Id . parse) parse 584 where f d = either (NoptrDeclarator_WithParams d) (NoptrDeclarator_Squared d) 585 586instance Parse DeclaratorId where autoname_parse = auto2 DeclaratorId_IdExpression 587 -- We don't even try to parse a DeclaratorId_Nested, because we can't tell it apart from an IdExpression anyway. 588 589instance Parse TypeId where autoname_parse = typeP id (\x y → TypeId (TypeSpecifierSeq x) $ AbstractDeclarator_PtrAbstractDeclarator . y) 590 591typeP :: (Parse c, Convert b (Maybe (CvQualifier, White)), Convert TypeSpecifier b, ParseSpecifier b) ⇒ 592 (Maybe PtrAbstractDeclarator → c) → (NeList b → c → a) → Parser Char a 593typeP g h = makeTypeExtensions . parseOptions >>= \b → flip fix [] $ \self specs → do 594 pspec ← parsePrimarySpec; sspecs ← many parseSecondarySpec 595 let (p, q) = neElim $ NeList.reverse $ pspec :| specs 596 r ← parse 597 return $ h (p :| (q ++ sspecs)) r 598 <|> (((: specs) . parseSecondarySpec) >>= self) 599 <|> if not b then pzero else do 600 let (noncvs, cvs) = partitionMaybe (\x → convert x :: Maybe (CvQualifier, White)) specs 601 (x, y) ← apply (map fst cvs) . type_desc 602 return $ uncurry h $ second g $ case y of 603 Left s → (prefixNeList noncvs (fmap convert $ with_default (s:x)), Nothing) 604 Right ad → (prefixNeList noncvs (fmap convert $ with_default x), Just ad) 605 606instance Parse Initializer where autoname_parse = auto1 Initializer_Parenthesized <|> auto1 Initializer_BraceOrEqualInitializer 607instance Parse BraceOrEqualInitializer where autoname_parse = auto2 EqualInitializer <|> auto1 BraceInitializer 608instance Parse BracedInitList where autoname_parse = auto1 BracedInitList 609instance Parse ParametersAndQualifiers where autoname_parse = memoize $ auto4 ParametersAndQualifiers 610 {- This memoize prevents an exponential explosion in 611 { int b; a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(a(b+b)))))))))))))))))))))))); } 612 -} 613 614instance Parse TrailingReturnType where autoname_parse = auto3 TrailingReturnType 615 616instance Parse ParameterDeclarationClause where 617 autoname_parse = 618 ParameterDeclarationClause Nothing . Just . parse <|> (do 619 l ← parse 620 auto2 (ParameterDeclarationClauseWithEllipsis l) <|> ParameterDeclarationClause (Just l) . parse 621 ) <|> return (ParameterDeclarationClause Nothing Nothing) 622 623instance Parse ParameterDeclarationList where autoname_parse = auto1 ParameterDeclarationList 624instance Parse ParameterDeclaration where autoname_parse = typeP (Right . (AbstractDeclarator_PtrAbstractDeclarator .)) (ParameterDeclaration . DeclSpecifierSeq) >>= auto1 625 626-- Consider the simple-declaration x y(); . If we just start by parsing a list of decl/type-specifiers, we get [x, y], and consequently we will never succeed in parsing a simple-declaration. For this reason, we distinguish between primary and secondary specifiers, where the former may only occur once in specifier lists. We then parse specifier lists in such a way that we stop when a second primary specifier is encountered (and don't include it in the resulting list). In the example, both x and y are primary specifiers, and so only x becomes part of the list, leaving y to be (correctly) parsed as part of the declarator. 627-- There is one context in which this is not sufficient: constructor declarations. In a constructor declaration T(); , the T is not part of the specifier sequence, but part of the declarator. There, we use a manyTill to stop parsing specifiers as soon as what follows is a valid declarator. 628-- We could also use manyTill everywhere and get rid of the primary/secondy distinction, but having the distinction is easier, because it greatly simplifies treatment of other decl-specifier-seq/type-specifier-seq occurrences (because they can just rely on the Parse instances for those respective productions). 629 630class ParseSpecifier s where parsePrimarySpec, parseSecondarySpec :: Parser Char s 631 632instance ParseSpecifier TrailingTypeSpecifier where 633 parsePrimarySpec = (<?> "trailing-type-specifier") $ TrailingTypeSpecifier_SimpleTypeSpecifier . primarySimpleTypeSpecifier <|> TrailingTypeSpecifier_TypenameSpecifier . parse <|> TrailingTypeSpecifier_ElaboratedTypeSpecifier . parse 634 parseSecondarySpec = (<?> "trailing-type-specifier") $ TrailingTypeSpecifier_CvQualifier . parse <|> TrailingTypeSpecifier_SimpleTypeSpecifier . LengthSpec . parse <|> TrailingTypeSpecifier_SimpleTypeSpecifier . SignSpec . parse <|> TrailingTypeSpecifier_SimpleTypeSpecifier . SimpleTypeSpecifier_BasicType . parse 635 636instance ParseSpecifier TypeSpecifier where 637 parsePrimarySpec = (<?> "type-specifier") $ TypeSpecifier_ClassSpecifier . parse <|> TypeSpecifier_TrailingTypeSpecifier . parsePrimarySpec <|> TypeSpecifier_EnumSpecifier . parse 638 parseSecondarySpec = (<?> "type-specifier") $ TypeSpecifier_TrailingTypeSpecifier . parseSecondarySpec 639 640instance ParseSpecifier DeclSpecifier where 641 parsePrimarySpec = DeclSpecifier_TypeSpecifier . parsePrimarySpec 642 parseSecondarySpec = DeclSpecifier_StorageClassSpecifier . parse <|> DeclSpecifier_FunctionSpecifier . parse <|> DeclSpecifier_Friend . parse <|> DeclSpecifier_Typedef . parse <|> DeclSpecifier_ConstExpr . parse <|> DeclSpecifier_AlignmentSpecifier . parse <|> DeclSpecifier_TypeSpecifier . parseSecondarySpec 643 644primarySimpleTypeSpecifier :: Parser Char SimpleTypeSpecifier 645primarySimpleTypeSpecifier = (<?> "simple-type-specifier") $ SimpleTypeSpecifier_BasicType . parse 646 <|> auto2 SimpleTypeSpecifier_DeclType <|> auto2 SimpleTypeSpecifier_TypeName <|> auto1 LengthSpec <|> auto1 SignSpec <|> auto1 SimpleTypeSpecifier_Auto 647 648instance ParseSpecifier MakeSpecifier where 649 parsePrimarySpec = (<?> "make-specifier") $ MakeSpecifier_DeclSpecifier . parsePrimarySpec 650 parseSecondarySpec = (<?> "make-specifier") $ 651 (symbols "non" >> NonFunctionSpecifier . fst . (parse :: Parser Char (FunctionSpecifier, White))) <|> 652 (symbols "non" >> NonStorageClassSpecifier . fst . (parse :: Parser Char (StorageClassSpecifier, White))) <|> 653 (symbols "non" >> NonCv . fst . (parse :: Parser Char (CvQualifier, White))) <|> 654 (symbols "non" >> NonSign . fst . (parse :: Parser Char (Sign, White))) <|> 655 (symbols "non" >> NonLength . fst . (parse :: Parser Char (LengthSpec, White))) <|> 656 (symbols "implicit" >> return (NonFunctionSpecifier Explicit)) <|> 657 MakeSpecifier_DeclSpecifier . parseSecondarySpec 658 659instance Parse TypeSpecifierSeq where 660 autoname_parse = 661 TypeSpecifierSeq . (liftM2 (:|) parsePrimarySpec (many parseSecondarySpec) <|> liftM2 (:|) parseSecondarySpec lp) 662 where lp = liftM2 (:) parsePrimarySpec (many parseSecondarySpec) <|> liftM2 (:) parseSecondarySpec lp <|> return [] 663 664instance Parse TrailingTypeSpecifierSeq where autoname_parse = auto1 TrailingTypeSpecifierSeq 665 666instance Parse DeclSpecifier where autoname_parse = parsePrimarySpec <|> parseSecondarySpec 667 668instance Parse FunctionDefinition where 669 autoname_parse = do 670 (declspecs, (declarator, body)) ← manyTill parse (liftM2 (,) parse parse) 671 return $ FunctionDefinition (convert (declspecs :: [DeclSpecifier])) declarator body 672 673instance Parse FunctionBody where autoname_parse = auto2 FunctionBody <|> auto1 FunctionBody_FunctionTryBlock <|> auto3 DefaultedFunctionBody <|> auto3 DeletedFunctionBody 674 675-- A.8 Classes [gram.class] 676 677instance Parse ClassSpecifier where autoname_parse = auto2 ClassSpecifier 678instance Parse ClassHead where autoname_parse = auto3 ClassHead 679instance Parse ClassHeadKind where parse = auto2 ClassHeadKind_SimpleTemplateId <|> auto2 ClassHeadKind_NestedIdentifier <|> auto1 ClassHeadKind_Identifier 680instance Parse MemberSpecification where autoname_parse = auto1 MemberSpecification 681instance Parse MemberAccessSpecifier where autoname_parse = auto2 MemberAccessSpecifier 682instance Parse MemberDeclaration where 683 autoname_parse = do 684 (x, (y, z)) ← manyTill parse (liftM2 (,) parse parse) 685 return $ MemberDeclaration (convert (x :: [DeclSpecifier])) y z 686 <|> auto2 MemberFunctionDefinition <|> auto1 MemberUsingDeclaration <|> auto1 MemberTemplateDeclaration 687instance Parse MemberDeclaratorList where autoname_parse = auto1 MemberDeclaratorList 688instance Parse MemberDeclarator where autoname_parse = auto3 BitField <|> auto2 MemberDeclarator 689instance Parse PureSpecifier where autoname_parse = auto2 PureSpecifier 690 691-- A.9 Derived classes [gram.derived] 692 693instance Parse BaseSpecifierList where autoname_parse = auto1 BaseSpecifierList 694instance Parse BaseSpecifier where autoname_parse = auto3 BaseSpecifier 695instance Parse BaseClause where autoname_parse = auto2 BaseClause 696 697-- A.10 Special member functions [gram.special] 698 699instance Parse ConversionTypeId where autoname_parse = auto2 ConversionTypeId 700instance Parse CtorInitializer where autoname_parse = auto2 CtorInitializer 701instance Parse MemInitializerList where autoname_parse = auto1 MemInitializerList 702instance Parse MemInitializer where autoname_parse = auto2 MemInitializer 703instance Parse MemInitializerId where autoname_parse = auto2 MemInitializerId_ClassName <|> auto1 MemInitializerId_Identifier 704 705-- A.11 Overloading [gram.over] 706 707instance Parse OverloadableOperator where 708 parse = (<?> "overloadable operator") $ 709 auto2 OverloadableOperator_New <|> auto2 OverloadableOperator_Delete <|> 710 auto1 OverloadableOperator_Call <|> auto1 OverloadableOperator_Index <|> auto1 OverloadableUnaryOperator <|> auto1 OverloadableAssignmentOperator <|> auto1 OverloadableRelationalOperator <|> auto1 OverloadableMultiplicativeOperator <|> auto1 OverloadableShiftOperator <|> auto1 OverloadableAdditiveOperator <|> auto1 OverloadableEqualityOperator <|> auto1 OverloadableBitXor <|> auto1 OverloadableBitAnd <|> auto1 OverloadableBitOr <|> auto1 OverloadableLogicalAnd <|> auto1 OverloadableLogicalOr <|> auto1 OverloadableComma <|> auto1 OverloadablePmOperator <|> auto1 OverloadableArrowOperator 711 712instance Parse OperatorFunctionId where autoname_parse = auto2 OperatorFunctionId 713 714-- A.12 Templates [gram.temp] 715 716instance Parse TemplateArguments where autoname_parse = memoize $ auto1 TemplateArguments 717 718{- Consider the following code: 719 720 {a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a<a; int i; } 721 722At each '<', the parser first tries parsing it as the beginning of a template argument list, before it falls back on treating it as operator<. Hence, without memoization, the above takes exponential time to parse. To solve this, we memoize parsing results. -} 723 724instance Parse TemplateId where autoname_parse = auto2 TemplateId_OperatorFunctionId <|> auto1 TemplateId_SimpleTemplateId 725instance Parse TypenameSpecifier where autoname_parse = auto4 TypenameSpecifier 726instance Parse SimpleTemplateId where autoname_parse = auto2 SimpleTemplateId 727instance Parse TemplateArgumentList where autoname_parse = auto1 TemplateArgumentList 728instance Parse TemplateArgument where autoname_parse = auto1 TemplateArgument_TypeId <|> auto1 TemplateArgument_ConstantExpression <|> auto1 TemplateArgument_IdExpression 729 -- Todo: There's probably potential for factoring here. 730instance Parse TemplateDeclaration where autoname_parse = auto4 TemplateDeclaration 731instance Parse TemplateParameterList where autoname_parse = auto1 TemplateParameterList 732instance Parse TemplateParameter where autoname_parse = auto1 TemplateParameter_TypeParameter <|> auto1 TemplateParameter_ParameterDeclaration 733instance Parse TypeParameter where autoname_parse = auto3 TypeParameter_Class <|> auto5 TypeParameter_Template 734instance Parse ExplicitInstantiation where autoname_parse = auto3 ExplicitInstantiation 735instance Parse ExplicitSpecialization where autoname_parse = auto3 ExplicitSpecialization 736 737-- A.13 Exception handling [gram.except] 738 739instance Parse ExceptionSpecification where autoname_parse = auto2 ExceptionSpecification 740instance Parse TypeIdList where autoname_parse = auto1 TypeIdList 741instance Parse TryBlock where autoname_parse = auto3 TryBlock 742instance Parse FunctionTryBlock where autoname_parse = auto4 FunctionTryBlock 743instance Parse HandlerSeq where autoname_parse = auto1 HandlerSeq 744instance Parse Handler where autoname_parse = auto3 Handler 745instance Parse ExceptionDeclaration where autoname_parse = auto1 ExceptionDeclaration_Ellipsis <|> auto2 ExceptionDeclaration 746 747-- A.14 Preprocessing directives [gram.cpp]