content: {-# LANGUAGE UnicodeSyntax, ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, OverlappingInstances, GADTs, TypeOperators, TypeFamilies, PatternGuards, DeriveDataTypeable #-}
  {-# OPTIONS_GHC -O0 #-}
  
  {- 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.
  
  However, 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:
  
    x*y;
  
  we 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).
  
  Here are some more typical ambiguous constructs:
  
    int x(y); // If y is a type, this is a function declaration. Otherwise, it's a variable definition.
    x<y> z; // If x is a template, this is a variable declaration. Otherwise, it's an expression-statement.
    x(y); // If x is a type, this is a variable declaration. Otherwise, it's a function call.
    x+(y)(z); // if y is a type, (y)(z) is a cast. Otherwise, it's a function call.
  
  We always prefer parsing things as declarations.
  
  Note 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.
  
  This C++ parser is probably extremely inefficient. Fortunately, geordi only ever runs it on tiny C++ snippets, so we just don't care.
  
  -}
  
  module Cxx.Parse (Chunk(..), code, charLit, stringLit, makeType, precedence, parseRequest, makeDeclParser, declaratorIdParser, highlight) where
  
  import qualified Data.Char as Char
  import qualified Data.List as List
  import qualified Data.List.NonEmpty as NeList
  import qualified Parsers as P
  import qualified Cxx.Show
  import Control.Arrow (first, second)
  import Control.Applicative (Applicative(..))
  import Control.Monad.Fix (fix)
  import Control.Monad.Instances ()
  import Control.Monad (liftM2, liftM3, when)
  import Data.List ((\\))
  import Data.List.NonEmpty (NonEmpty(..))
  import Data.Generics (Data, Typeable, dataTypeOf)
  import Data.Maybe (mapMaybe)
  import Data.Function (on)
  import Data.Foldable (toList)
  import Util ((<<), (.), Convert(..), isIdChar, Finite(..), Phantom(..), cardinals, partitionMaybe, TriBool(..), (.∨.), NeList, neElim, prefixNeList, neInitLast)
  import Cxx.Basics
  import Cxx.Show (pretty_with_precedence, Highlighter)
  import Cxx.Operations (apply, squared, is_primary_TypeSpecifier, parenthesized, specT, split_all_decls, is_pointer_or_reference)
  import Prelude hiding ((.))
  import Prelude.Unicode
  import Control.Monad.Reader (ReaderT(..))
  import Parsers ((<?>), (<|>), pzero, spaces, many, optional, choice, sep, many1, symbols, noneOf, lookAhead, symbol, satisfy, optionMaybe, anySymbol, manyTill, many1Till, oneOf, ParserLike, eof, ParseResult(..), getInput, sepBy1, option)
  import MemoTrie (memo, Trie(..), PairTrie(..), BoolTrie(..))
  
  -- Custom parsing monad:
  
  data ParseOptions = ParseOptions { makeTypeExtensions :: Bool, pendingCloseAngleBracket :: Bool }
  
  instance Trie ParseOptions (PairTrie BoolTrie BoolTrie) where
    trie f = trie (\(x, y) → f $ ParseOptions x y)
    untrie f (ParseOptions x y) = untrie f (x, y)
  
  defaultParseOptions :: ParseOptions
  defaultParseOptions = ParseOptions { makeTypeExtensions = False, pendingCloseAngleBracket = False }
  
  type Parser t = ReaderT ParseOptions (P.Parser t)
  
  instance ParserLike (Parser a) a where
    anySymbol = ReaderT $ const anySymbol
    eof = ReaderT $ const eof
    pzero = ReaderT $ const pzero
    ReaderT p <?> s = ReaderT $ (<?> s) . p
    ReaderT p <|> ReaderT q = ReaderT $ \o → p o <|> q o
    symbols = ReaderT . const . symbols
    satisfy = ReaderT . const . satisfy
    lookAhead (ReaderT p) = ReaderT $ lookAhead . p
    try = id
  
  parseOptions :: Parser t ParseOptions
  parseOptions = ReaderT return
  
  -- Some combinators:
  
  silent :: Parser a b → Parser a b
  silent (ReaderT f) = ReaderT $ P.silent . f
  
  guarded :: (a → Bool) → Parser t a → Parser t a
  guarded f (ReaderT p) = ReaderT $ P.guarded f . p
  
  memoize :: Parser Char a → Parser Char a
  memoize (ReaderT p) = ReaderT $ \o → P.Parser $ \s → m (o, s)
    where m = memo $ \(o, s) → P.run_parser (p o) s
      -- 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.
  
  notFollowedBy :: Parser t a → Parser t ()
  notFollowedBy (ReaderT p) = ReaderT $ P.notFollowedBy . p
  
  -- Primary module exports
  
  precedence :: String → Either String String
  precedence s = either (pretty_with_precedence . split_all_decls) (pretty_with_precedence . split_all_decls) .
    P.parseOrFail p (dropWhile Char.isSpace s) "code"
    where p = runReaderT (parse << eof) defaultParseOptions :: P.Parser Char (Either Expression [Statement])
  
  highlight :: Highlighter → String → String
  highlight h s =
    case P.run_parser p (dropWhile Char.isSpace s) of
      ParseSuccess r _ _ _ → Cxx.Show.show_pretty False h r
      ParseFailure{} → s
    where p = runReaderT (parse << eof) defaultParseOptions :: P.Parser Char GeordiRequest
  
  parseRequest :: String → Either String GeordiRequest
  parseRequest s = P.parseOrFail (runReaderT (parse << eof) defaultParseOptions) s "request"
  
  makeType :: String → Either String TypeId
  makeType s = P.parseOrFail (runReaderT (parse << eof) (defaultParseOptions { makeTypeExtensions = True })) (dropWhile Char.isSpace s) "type description"
  
  -- Chunk/Code parsers
  
  textLit :: ParserLike m Char ⇒ Char → m String
  textLit q = (symbol q >>) $ fix $ \h → do
    s ← many $ noneOf [q, '\\']
    c ← anySymbol
    if c == '\\'
      then do d ← anySymbol; r ← h; return $ s ++ ('\\':d:r)
      else return s
  
  rawStringLit :: ParserLike m Char ⇒ m Chunk
  rawStringLit = do
    symbols "R\""
    x <- fst . (anySymbol `manyTill` symbol '(')
    y <- fst . (anySymbol `manyTill` P.try (symbols (')' : x) >> symbol '"'))
    return $ RawStringLiteral x y
  
  -- Parsec's Haskell char/string literal parsers consume whitespace, and save the value rather than the denotation.
  
  charLit, stringLit, digits, plain, parens, curlies, squares, multiComment, singleComment :: ParserLike m Char ⇒ m Chunk
  
  charLit = CharLiteral . textLit '\''
  stringLit = StringLiteral' . textLit '"'
  digits = Plain . (liftM2 (:) (satisfy Char.isDigit) (many (satisfy (\c -> Char.isDigit c || c == '\''))))
  plain = Plain . ((:[]) . oneOf ";\\" <|> toList . many1 punct <|> toList . many1 (satisfy Char.isAlpha))
    where
      punct = do
        c <- satisfy (\c -> not (Char.isAlphaNum c) && not (c `elem` "'\"{([])};\\"))
        when (c == '/') $ lookAhead (noneOf "*/") >> return ()
        return c
  parens = Parens . (symbol '(' >> code << symbol ')')
  curlies = Curlies . (symbol '{' >> code << symbol '}')
  squares = Squares . (symbol '[' >> code << symbol ']')
  multiComment = MultiComment . (symbols "/*" >> fst . manyTill anySymbol (symbols "*/"))
  singleComment = SingleComment . (symbols "//" >> many (noneOf "\\"))
  
  code :: ParserLike m Char ⇒ m Code
  code = many $ (<?> "balanced code") $
    multiComment <|> singleComment <|> charLit <|> parens <|> curlies <|> squares
    <|> stringLit <|> rawStringLit <|> digits <|> plain
    -- Uncovers just enough structure for Request.hs to find the split positions in "<< ...; ..." and "{ ... } ..." requests and to implement --resume.
  
  -- Misc parsers.
  
  kwd :: String → Parser Char White
  kwd x = symbols x >> notFollowedBy (satisfy isIdChar) >> parse
  
  makeDeclParser :: P.Parser Char MakeDeclaration
  makeDeclParser = runReaderT parse (defaultParseOptions { makeTypeExtensions = True })
  
  declaratorIdParser :: P.Parser Char DeclaratorId
  declaratorIdParser = runReaderT parse defaultParseOptions
  
  anyOperator :: Parser Char (OperatorTok, White)
  anyOperator = (<?> "operator") $ do
    o ← parseOptions
    liftM2 (,) (choice $ if pendingCloseAngleBracket o then pcab else normal) parse
    where
      normal = map (\x → symbols (show x) >> return x) $ List.sortBy (flip compare `on` length . show) (all_values :: [OperatorTok])
      pcab = map (\x → symbols (show x) >> return x) $ List.sortBy (flip compare `on` length . show) $ (all_values :: [OperatorTok]) \\ [CloseTwoAngles, CloseAngle]
        -- Profiling showed that having these two separate makes a huge difference in space/time efficiency.
  
  op :: OperatorTok → Parser Char White
  op o = (<?> operatorTokName o) $ snd . guarded ((== o) . fst) anyOperator
  
  class Data a ⇒ Parse a where
    parse :: Parser Char a
    parse = autoname_parse <?> Cxx.Show.dataType_productionName (dataTypeOf (undefined :: a))
    autoname_parse :: Parser Char a
    autoname_parse = parse
      -- autoname_parse must never be used--it is merely a hook for parse.
  
  instance (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
  instance Parse White where
    parse = silent $ White . concat . many (
      (symbols "/*" >> ("/*" ++) . (++ "*/") . fst . manyTill anySymbol (symbols "*/")) <|>
      (symbols "//" >> ("//" ++) . getInput) <|> symbols " ")
  
  instance Parse a ⇒ Parse [a] where parse = many parse
  instance Parse a ⇒ Parse (Maybe a) where parse = optionMaybe parse
  instance Parse a ⇒ Parse (Enclosed a) where parse = Enclosed . parse
  instance (Parse a, Parse b) ⇒ Parse (a, b) where parse = auto2 (,)
  instance (Parse a, Parse b, Parse c) ⇒ Parse (a, b, c) where parse = auto3 (,,)
  instance (Parse a, Parse b, Parse c, Parse d) ⇒ Parse (a, b, c ,d) where parse = auto4 (,,,)
  instance Parse a ⇒ Parse (Commad a) where parse = liftM2 Commad parse (many (liftM2 (,) parse parse))
  instance (Parse a, Parse b) ⇒ Parse (Either a b) where parse = Left . parse <|> Right . parse
  instance Parse a ⇒ Parse (Angled a) where parse = liftM3 Angled parse (ReaderT $ \o → runReaderT parse (o { pendingCloseAngleBracket = True })) (liftM2 (,) (symbol '>' >> return CloseAngle_) parse)
  instance Parse a ⇒ Parse (Squared a) where parse = liftM3 Squared parse (ReaderT $ \o → runReaderT parse $ o { pendingCloseAngleBracket = False }) parse
  instance Parse a ⇒ Parse (Curlied a) where parse = liftM3 Curlied parse (ReaderT $ \o → runReaderT parse $ o { pendingCloseAngleBracket = False }) parse
  instance Parse a ⇒ Parse (Parenthesized a) where parse = parseParenthesized parse
  instance Parse () where parse = return ()
  instance Parse a ⇒ Parse (NeList a) where parse = many1 parse
  
  parseParenthesized :: Parser Char (Enclosed a) → Parser Char (Parenthesized a)
  parseParenthesized p = liftM3 Parenthesized parse (ReaderT $ \o → runReaderT p $ o { pendingCloseAngleBracket = False }) parse
  
  an :: Parser Char (Maybe White)
  an = silent $ optional $ kwd "an" <|> kwd "a"
  
  pluralP :: String → Parser Char ()
  pluralP s = (>> return ()) $ kwd s <|> kwd (s ++ "s")
  
  delim :: Parser Char ()
  delim = (op CommaTok >> optional (kwd "and") >> return ()) <|> (kwd "and" >> return ())
  
  takingP :: Parser Char ParameterDeclarationClause
  takingP =
    ((kwd "nothing" <|> (kwd "no" >> kwd "arguments")) >> return (ParameterDeclarationClause Nothing Nothing)) <|> mkParameterDeclarationClause . concat . sepBy1 takingClause (delim >> ((kwd "returning" >> pzero) <|> return ()))
  
  commad :: NeList x → Commad x
  commad l = Commad (NeList.head l) $ (,) (CommaOp, White " ") . NeList.tail l
  
  mkParameterDeclarationClause :: [ParameterDeclaration] → ParameterDeclarationClause
  mkParameterDeclarationClause l =
    ParameterDeclarationClause (case l of [] → Nothing; h:t → (Just $ ParameterDeclarationList $ commad $ h :| t)) Nothing
  
  instance Parse (CvQualifier, White) where
    parse = (<?> "cv-qualifier") $ do
      b ← makeTypeExtensions . parseOptions
      (if b then (,) Const . kwd "constant" else pzero) <|> (,) Const . kwd "const" <|> (,) Volatile . kwd "volatile"
  
  instance Parse CvQualifierSeq where autoname_parse = auto1 CvQualifierSeq
  
  takingClause :: Parser Char [ParameterDeclaration]
  takingClause = (do
    IntegerLiteral s ← parse
    let (n :: Integer) = read s
    if n > 10 then pzero else replicate (fromInteger n) . parse) <|> (:[]) . (an >> parse)
  
  instance Parse MakeDeclaration where
    parse = (<?> "type description") $ (an >>) $ (longlong .) $ flip fix [] $ \self specs → do
      pspec ← parsePrimarySpec
      sspecs ← many parseSecondarySpec
      (\x → MakeDeclaration (reverse specs ++ pspec : sspecs) x Indeterminate) . parse
      <|> (((: specs) . parseSecondarySpec) >>= self)
      <|> do
        kwd "pure"
        let virtSpec = MakeSpecifier_DeclSpecifier $ DeclSpecifier_FunctionSpecifier (Virtual, White " ")
        do { MakeDeclaration l m _ ← self specs; return $ MakeDeclaration (virtSpec : l) m Definitely } <|> return (MakeDeclaration (virtSpec : specs) Nothing Definitely)
      <|> do
        kwd "impure" <|> kwd "nonpure"
        do { MakeDeclaration l m _ ← self specs; return $ MakeDeclaration l m DefinitelyNot } <|> return (MakeDeclaration specs Nothing DefinitelyNot)
      <|> do
      let (noncvs, cvs) = partitionMaybe (convert :: MakeSpecifier → Maybe (CvQualifier, White)) specs
      (x, y) ← type_desc
      return $ (\(p, q) → MakeDeclaration p q Indeterminate) $ apply (map fst cvs) $ case y of
        Left s → (noncvs ++ MakeSpecifier_DeclSpecifier . DeclSpecifier_TypeSpecifier . (x ++ [s]), Nothing)
        Right ad → (noncvs ++ MakeSpecifier_DeclSpecifier . DeclSpecifier_TypeSpecifier . x, Just ad)
      <|> (\x → MakeDeclaration specs x Indeterminate) . (if null specs then Just . parse else parse)
      where
        longlong m@(MakeDeclaration l x y)
          | (p, q) ← List.partition (== convert LongSpec) l, length p ≥ 2 = MakeDeclaration (LongLong : q) x y
          | otherwise = m
  
  literalArrayBound :: IntegerLiteral → ConstantExpression
  literalArrayBound = 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 "")
  
  type_desc :: Parser Char ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator)
    -- Todo: Document this type
  type_desc = (<?> "type description") $ do
        o ← (pluralP "pointer" >> return (PtrOperator_Ptr (StarOperator, White "") Nothing))
          <|> (\k → PtrOperator_Ref (k, White "")) . (((kwd "rvalue" >> return Rvalue) <|> (optional (kwd "lvalue") >> return Lvalue)) << pluralP "reference")
        (kwd "to" >> an >> second Right . apply o . specdDesc) <|> ((,) [] . Right . flip apply (PtrAbstractDeclarator o Nothing) . (parse :: Parser Char (Maybe PtrAbstractDeclarator)))
      <|> do
        pluralP "array"
        let d = PtrAbstractDeclarator_NoptrAbstractDeclarator . NoptrAbstractDeclarator Nothing . Right . squared
        do
          kwd "of"; n ← ((d . Just . literalArrayBound . parse) << spaces) <|> return (d Nothing)
          second Right . apply n . specdDesc
         <|> do
          mad ← parse :: Parser Char (Maybe PtrAbstractDeclarator)
          return ([], Right $ apply mad (d Nothing))
      <|> liftM2 (flip apply) (op OpenParen >> specdDesc << op CloseParen) (parse :: Parser Char (Maybe PtrAbstractDeclarator))
      <|> do
        pluralP "function"
        let function_declarator taking = PtrAbstractDeclarator_NoptrAbstractDeclarator $ NoptrAbstractDeclarator Nothing (Left $ ParametersAndQualifiers (parenthesized taking) Nothing Nothing Nothing)
        do
          taking ← kwd "taking" >> takingP
          do
            second Right . apply (function_declarator taking) . (optional delim >> kwd "returning" >> an >> specdDesc) <|> return ([], Right $ function_declarator taking)
          <|> do
          second Right . liftM2 (flip apply) (kwd "returning" >> an >> specdDesc) (function_declarator . ((optional delim >> kwd "taking" >> takingP) <|> return (mkParameterDeclarationClause [])))
          <|> do
          (,) [] . Right . flip apply (function_declarator $ mkParameterDeclarationClause []) . (parse :: Parser Char (Maybe PtrAbstractDeclarator))
    where
      specdDesc :: Parser Char ([TypeSpecifier], Either TypeSpecifier PtrAbstractDeclarator)
      specdDesc = (<?> "type description") $ flip fix [] $ \self specs → do
        morespecs ← liftM2 (:|) parsePrimarySpec (many parseSecondarySpec)
        let ne = prefixNeList specs morespecs
        mad ← parse :: Parser Char (Maybe PtrAbstractDeclarator)
        return $ case mad of
          Nothing → second Left $ neInitLast ne
          Just ad → (toList ne, Right ad)
       <|> do
        sspec ← parseSecondarySpec
        self (specs ++ [sspec]) <|> return ([], Left sspec)
       <|> do
        let (noncvs, cvs) = partitionMaybe (convert :: TypeSpecifier → Maybe (CvQualifier, White)) specs
        first (noncvs ++) . apply (map fst cvs) . type_desc
  
  with_default :: [TypeSpecifier] → NeList TypeSpecifier
  with_default [] = return specT
  with_default l@(h:t) = if any is_primary_TypeSpecifier l then h :| t else specT :| l
  
  instance Parse GeordiRequestWithoutWhite where
    parse = auto3 GeordiRequest_Print <|> auto2 GeordiRequest_Block <|> auto1 GeordiRequest_TU <|> auto2 GeordiRequest_Call
  
  parseAnyMixOf :: Parser t a → Parser t b → Parser t (AnyMixOf a b)
  parseAnyMixOf p q = (p >>= \x → MixAB x . q <|> return (MixA x)) <|> (q >>= \y → MixBA y . p <|> return (MixB y)) <|> return MixNone
  
  instance (Parse a, Parse b) ⇒ Parse (AnyMixOf a b) where parse = parseAnyMixOf parse parse
  
  instance Parse OptQualified where parse = auto2 OptQualified <?> "optional qualification"
  
  auto1 :: (Parse a) ⇒ (a → b) → Parser Char b
  auto1 f = f . parse
  auto2 :: (Parse a, Parse b) ⇒ (a → b → c) → Parser Char c
  auto2 f = auto1 f <*> parse
  auto3 :: (Parse a, Parse b, Parse c) ⇒ (a → b → c → d) → Parser Char d
  auto3 f = auto2 f <*> parse
  auto4 :: (Parse a, Parse b, Parse c, Parse d) ⇒ (a → b → c → d → e) → Parser Char e
  auto4 f = auto3 f <*> parse
  auto5 :: (Parse a, Parse b, Parse c, Parse d, Parse e) ⇒ (a → b → c → d → e → f) → Parser Char f
  auto5 f = auto4 f <*> parse
  auto6 :: (Parse a, Parse b, Parse c, Parse d, Parse e, Parse f) ⇒ (a → b → c → d → e → f → g) → Parser Char g
  auto6 f = auto5 f <*> parse
  
  
  -- Parse instances for all the grammar productions.
  
  -- A.1 Keywords [gram.key]
  
  instance Parse TemplateName where autoname_parse = auto1 TemplateName
  
  -- A.2 Lexical conventions [gram.lex]
  
  instance Parse Identifier where
    autoname_parse = do
      b ← makeTypeExtensions . parseOptions
      let k = keywords ++ if b then make_type_keywords else []
      liftM2 Identifier (guarded (not . (`elem` k)) $ liftM2 (:) (satisfy $ Char.isAlpha .∨. (== '_')) (many $ satisfy isIdChar)) parse
  
  instance Parse ClassName where autoname_parse = auto1 ClassName_TemplateId <|> auto1 ClassName_Identifier
  instance Parse TypeName where autoname_parse = auto1 TypeName_ClassName
  
  instance Parse FloatingLiteral where
    autoname_parse = (FloatingLiteral .) $ (>++> optSuffix) $
      (symbols "." >++> (toList . many1 digit) >++> option "" exponentPart) <|>
      ((toList . many1 digit) >++> ((symbols "." >++> many digit >++> option "" exponentPart >++> optSuffix) <|> exponentPart))
      where
        (>++>) = liftM2 (++)
        digit = satisfy Char.isDigit
        optSuffix = option "" $ (:[]) . (symbol 'f' <|> symbol 'l' <|> symbol 'F' <|> symbol 'L')
        exponentPart = (symbols "e" <|> symbols "E") >++> option "" (symbols "+" <|> symbols "-") >++> (toList . many1 digit)
  instance Parse IntegerLiteral where
    autoname_parse = (IntegerLiteral .) $ (p <|>) $ do
      b ← makeTypeExtensions . parseOptions
      if b then choice $ zipWith (\n s → kwd s >> return (show n)) [0::Int ..] cardinals else pzero
     where p = liftM2 (:) (satisfy Char.isDigit) (many (satisfy Char.isAlphaNum) << notFollowedBy (satisfy isIdChar))
  instance Parse EncodingPrefix where
    parse = (symbols "u8" >> return EncodingPrefix_u8) <|> (symbol 'u' >> return EncodingPrefix_u) <|> (symbol 'U' >> return EncodingPrefix_U) <|> (symbol 'L' >> return EncodingPrefix_L)
  instance Parse SingleStringLiteral where parse = liftM2 SingleStringLiteral parse (textLit '"')
  instance Parse StringLiteral where autoname_parse = StringLiteral . many1 (auto2 (,))
  instance Parse CharacterLiteralKind where parse = (symbol 'u' >> return CharacterLiteralKind_u) <|> (symbol 'U' >> return CharacterLiteralKind_U) <|> (symbol 'L' >> return CharacterLiteralKind_L) <|> return CharacterLiteral_Plain
  instance Parse CharacterLiteral where parse = liftM2 CharacterLiteral parse (textLit '\'')
  instance Parse Literal where
    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"
  
  -- A.3 Basic concepts [gram.basic]
  
  instance Parse TranslationUnit where parse = TranslationUnit . parse
  
  -- A.4 Expressions [gram.expr]
  
  instance Parse PrimaryExpression where
    autoname_parse =
      auto1 PrimaryExpression_This <|> auto1 PrimaryExpression_Literal <|>
      auto1 PrimaryExpression_Expression <|> auto1 PrimaryExpression_IdExpression <|>
      auto1 PrimaryExpression_LambdaExpression
  instance Parse IdExpression where autoname_parse = auto1 IdExpression
  instance Parse UnqualifiedId where
    autoname_parse =
      (parse >>= \w → (UnqualifiedId_OperatorFunctionId . OperatorFunctionId w . parse <|> UnqualifiedId_ConversionFunctionId . ConversionFunctionId w . parse))
      <|> auto1 UnqualifiedId_TemplateId <|> auto1 UnqualifiedId_Identifier <|> auto2 UnqualifiedId_Destructor
  instance Parse QualifiedId where
    autoname_parse = (do
      w ← parse
      auto3 (NestedUnqualifiedId (Just w)) <|> GlobalIdentifier w . parse <|> GlobalOperatorFunctionId w . parse <|> GlobalTemplateId w . parse
     ) <|> auto3 (NestedUnqualifiedId Nothing)
  instance Parse NestedNameSpecifier where
    autoname_parse = liftM2 (foldl (flip ($)))
      (auto2 NestedNameSpecifier_TypeName)
      (many $ auto3 (\x y z u → NestedNameSpecifier_SimpleTemplateId u x y z) <|> auto2 (\x y z → NestedNameSpecifier_Identifier z x y))
        -- We can't distinguish a simple class-name from a namespace-name anyway, so we only try to parse a type-name here.
  instance Parse LambdaExpression where autoname_parse = auto3 LambdaExpression
  instance Parse LambdaIntroducer where autoname_parse = auto1 LambdaIntroducer
  instance Parse LambdaCapture where
    autoname_parse = (do
        def ← parse
        let sofar = LambdaCapture (Just def)
        m ← optionMaybe (liftM2 (,) parse parse)
        return $ case m of
          Just ((c,w), l) → sofar (Just (c, w)) (Just l)
          Nothing → sofar Nothing Nothing
      ) <|> auto1 (LambdaCapture Nothing Nothing . Just)
  instance Parse CaptureDefault where autoname_parse = auto1 CaptureDefault
  instance Parse CaptureList where autoname_parse = auto1 CaptureList
  instance Parse Capture where autoname_parse = auto2 Capture_Identifier <|> auto1 Capture_This
  instance Parse LambdaDeclarator where autoname_parse = auto4 LambdaDeclarator
  instance Parse PostfixExpression where
    autoname_parse = liftM2 (foldl $ flip ($)) basic $ many $ (<?> "postfix operator") $
        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)
      where
       basic = auto3 PostfixExpression_NewStyleCast <|> auto2 PostfixExpression_Conversion <|> auto2 PostfixExpression_TypeId <|> auto1 PostfixExpression_PrimaryExpression
  instance Parse ExpressionList where autoname_parse = auto1 ExpressionList
  instance Parse PseudoDestructorName where
    autoname_parse = do
      w ← parse
      mnns ← parse
      maybe pzero (auto5 . PseudoDestructorName_InTemplate w) mnns <|>
        auto2 (PseudoDestructorName (OptQualified w mnns)) <|>
        auto4 (PseudoDestructorName_InTypeName (OptQualified w mnns))
  simpleBinaryGroup :: (Parse (b, White), Parse a) ⇒ (a1 → (b, White) → a → a1) → (a → a1) → Parser Char a1
  simpleBinaryGroup c l = do
    (e, f) ← sep parse (parse <?> "binary operator")
    return $ foldl (\z ((o, w), y) → c z (o, w) y) (l e) f
  simplerBinaryGroup :: (Parse a) ⇒ Parser Char d → (a1 → d → a → a1) → (a → a1) → Parser Char a1
  simplerBinaryGroup p c l = do
      (e, f) ← sep parse (p <?> "binary operator")
      return $ foldl (\z (w, y) → c z w y) (l e) f
  instance Parse UnaryExpression where
    autoname_parse =
      (parse >>= \w → (UnaryExpression_Sizeof_TypeId w . parse <|> (UnaryExpression_Sizeof_UnaryExpression w . parse))) <|>
      auto2 UnaryExpression_AlignOf <|> auto2 UnaryExpression <|> UnaryExpression_NewExpression . parse <|> UnaryExpression_DeleteExpression . parse <|> UnaryExpression_PostfixExpression . parse
  instance Parse NewInitializer where autoname_parse = auto1 NewInitializer_ExpressionList <|> auto1 NewInitializer_BracedInitList
  instance Parse NewExpression where autoname_parse = auto5 NewExpression
  instance Parse NewPlacement where autoname_parse = auto1 NewPlacement
  instance Parse NewTypeId where autoname_parse = auto2 NewTypeId
  instance Parse NewDeclarator where autoname_parse = auto2 NewDeclarator_PtrOperator <|> auto1 NewDeclarator_NoptrNewDeclarator
  instance Parse NoptrNewDeclarator where parse = liftM2 NoptrNewDeclarator parse (reverse . parse)
  instance Parse DeleteExpression where autoname_parse = auto4 DeleteExpression
  instance Parse ThrowExpression where autoname_parse = auto2 ThrowExpression
  instance Parse CastExpression where autoname_parse = auto2 CastExpression_Cast <|> CastExpression_UnaryExpression . parse
  instance Parse PmExpression where autoname_parse = simpleBinaryGroup PmExpression PmExpression_CastExpression
  instance Parse MultiplicativeExpression where autoname_parse = simpleBinaryGroup MultiplicativeExpression MultiplicativeExpression_PmExpression
  instance Parse AdditiveExpression where autoname_parse = simpleBinaryGroup AdditiveExpression AdditiveExpression_MultiplicativeExpression
  instance Parse ShiftExpression where autoname_parse = simpleBinaryGroup ShiftExpression ShiftExpression_AdditiveExpression
  instance Parse RelationalExpression where autoname_parse = simpleBinaryGroup RelationalExpression RelationalExpression_ShiftExpression
  instance Parse EqualityExpression where autoname_parse = simpleBinaryGroup EqualityExpression EqualityExpression_RelationalExpression
  instance Parse AndExpression where autoname_parse = simplerBinaryGroup parse AndExpression AndExpression_EqualityExpression
  instance Parse ExclusiveOrExpression where autoname_parse = simplerBinaryGroup parse ExclusiveOrExpression ExclusiveOrExpression_AndExpression
  instance Parse InclusiveOrExpression where autoname_parse = simplerBinaryGroup parse InclusiveOrExpression InclusiveOrExpression_ExclusiveOrExpression
  instance Parse LogicalAndExpression where autoname_parse = simplerBinaryGroup parse LogicalAndExpression LogicalAndExpression_InclusiveOrExpression
  instance Parse LogicalOrExpression where autoname_parse = simplerBinaryGroup parse LogicalOrExpression LogicalOrExpression_LogicalAndExpression
  instance Parse ConditionalExpression where autoname_parse = ConditionalExpression_LogicalOrExpression . parse -- Todo: This is no good, I think.
  instance Parse AssignmentExpression where
    autoname_parse = (AssignmentExpression_ThrowExpression . parse <|>) $ do
      e ← parse
      AssignmentExpression_ConditionalExpression . auto4 (ConditionalExpression e) <|> auto2 (AssignmentExpression e) <|> return (AssignmentExpression_ConditionalExpression $ ConditionalExpression_LogicalOrExpression e)
  instance Parse Expression where autoname_parse = simplerBinaryGroup parse Expression_Comma Expression_AssignmentExpression
  instance Parse ConstantExpression where autoname_parse = auto1 ConstantExpression
  
  -- A.5 Statements [gram.stmt]
  
  instance Parse Statement where
    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
  
  instance Parse Label where parse = auto1 IdentifierLabel <|> auto2 CaseLabel <|> auto1 DefaultLabel
  instance Parse LabeledStatement where autoname_parse = auto3 LabeledStatement
  instance Parse IterationStatement where autoname_parse = auto3 WhileStatement <|> auto5 DoWhileStatement <|> auto3 ForStatement <|> auto3 RangeForStatement
  instance Parse ForInitStatement where autoname_parse = auto1 ForInitStatement_SimpleDeclaration <|> auto1 ForInitStatement_ExpressionStatement
  instance Parse ForRangeInitializer where autoname_parse = auto1 ForRangeInitializer_Expression <|> auto1 ForRangeInitializer_BracedInitList
  instance Parse ForRangeDeclaration where autoname_parse = uncurry ForRangeDeclaration . first DeclSpecifierSeq . many1Till parse parse
  instance Parse SelectionStatement where autoname_parse = auto4 IfStatement <|> auto3 SwitchStatement
  instance Parse JumpStatement where autoname_parse = auto2 BreakStatement <|> auto2 ContinueStatement <|> auto3 ReturnStatement <|> auto3 GotoStatement
  instance Parse ExpressionStatement where autoname_parse = auto2 ExpressionStatement
  instance Parse Condition where autoname_parse = auto1 Condition_Expression <|> auto3 Condition_Declaration
  instance Parse StatementSeq where autoname_parse = auto1 StatementSeq
  instance Parse CompoundStatement where autoname_parse = auto1 CompoundStatement
  instance Parse DeclarationStatement where autoname_parse = auto1 DeclarationStatement
  
  -- A.6 Declarations [gram.dcl]
  
  instance Parse DeclarationSeq where autoname_parse = auto1 DeclarationSeq
  instance 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
  instance 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
  instance Parse UsingDirective where parse = auto5 UsingDirective
  instance Parse AliasDeclaration where parse = auto5 AliasDeclaration
  instance Parse StaticAssertDeclaration where parse = auto3 StaticAssertDeclaration
  instance Parse NamespaceAliasDefinition where parse = auto6 NamespaceAliasDefinition
  instance Parse NamespaceName where parse = NamespaceName_OriginalNamespaceName . OriginalNamespaceName . parse
  instance Parse AsmDefinition where parse = auto3 AsmDefinition
    -- Things like AsmDefinition that only occur as specializations of more general productions need no expectation string.
  
  -- 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.
  
  data SpecialNoptrDeclarator = SpecialNoptrDeclarator { specialNoptrDeclarator :: NoptrDeclarator } deriving (Data, Typeable)
  
  instance Parse SpecialNoptrDeclarator where
    parse = auto2 $ \x y → SpecialNoptrDeclarator $ NoptrDeclarator_WithParams (NoptrDeclarator_Id x) y
      -- Todo: This is too simplistic. It will fail to parse (obscure) things like "(X)();" and "(X());".
  
  instance Parse SimpleDeclaration where
    parse = liftM2 (SimpleDeclaration Nothing) (Just . InitDeclaratorList . ((convert . specialNoptrDeclarator) .) . parse) parse <|> do
      (specs, (decls, semicolon)) ← many1Till parse (liftM2 (,) parse parse)
      return $ SimpleDeclaration (Just $ DeclSpecifierSeq specs) decls semicolon
  
  instance Parse UsingDeclaration where parse = parse >>= \w → auto5 (UsingDeclaration_Nested w) <|> auto3 (UsingDeclaration_NonNested w)
  instance Parse AlignmentSpecifier where autoname_parse = auto2 AlignmentSpecifier
  instance Parse (BasicType, White) where
    parse = do
      b ← makeTypeExtensions . parseOptions
      if not b
        then choice $ (\v → (,) v . either kwd op (token v)) . all_values
        else choice $ map (\(v, k) → (,) v . kwd k) $
          ((,) Int' . ["ints", "integer", "integers"]) ++
          ((,) Char' . ["chars", "character", "characters"]) ++
          ((,) Bool' . ["bools", "boolean", "booleans"]) ++
          [(Float', "floats"), (Double', "doubles"), (Void, "nothing")] ++
          mapMaybe (\v → either (Just . (,) v) (const Nothing) (token v)) all_values
  instance Parse SimpleTypeSpecifier where
    autoname_parse =
        SimpleTypeSpecifier_Auto . parse <|> SimpleTypeSpecifier_BasicType . parse
      <|> liftM2 SimpleTypeSpecifier_DeclType parse parse <|> LengthSpec . parse <|> SignSpec . parse
      <|> do
        w ← parse
        (parse >>= \nns → (auto2 (SimpleTypeSpecifier_SimpleTemplateId w nns) <|> SimpleTypeSpecifier_TypeName (OptQualified w (Just nns)) . parse)) <|> SimpleTypeSpecifier_TypeName (OptQualified w Nothing) . parse
  instance Parse TypeSpecifier where
    autoname_parse = auto1 TypeSpecifier_ClassSpecifier <|> auto1 TypeSpecifier_TrailingTypeSpecifier <|> auto1 TypeSpecifier_EnumSpecifier
  instance Parse TrailingTypeSpecifier where
    autoname_parse = auto1 TrailingTypeSpecifier_CvQualifier <|> auto1 TrailingTypeSpecifier_SimpleTypeSpecifier <|> auto1 TrailingTypeSpecifier_TypenameSpecifier <|> auto1 TrailingTypeSpecifier_ElaboratedTypeSpecifier
  instance Parse ElaboratedTypeSpecifier where autoname_parse = auto3 ElaboratedTypeSpecifier
  instance Parse EnumHead where autoname_parse = auto3 EnumHead
  instance Parse EnumBase where autoname_parse = auto2 EnumBase
  instance Parse EnumeratorList where autoname_parse = auto1 EnumeratorList
  instance Parse EnumeratorDefinition where autoname_parse = auto2 EnumeratorDefinition
  instance Parse Enumerator where autoname_parse = auto1 Enumerator
  instance Parse EnumKey where autoname_parse = parse >>= \e → EnumKey_Class e . parse <|> EnumKey_Struct e . parse <|> return (EnumKey e)
  instance Parse NamespaceDefinition where autoname_parse = auto4 NamespaceDefinition
  instance Parse NamespaceBody where autoname_parse = auto1 NamespaceBody
  instance Parse LinkageSpecification where autoname_parse = auto3 LinkageSpecification
  instance Parse EnumSpecifier where autoname_parse = auto2 EnumSpecifier
  
  -- A.7 Declarators [gram.decl]
  
  instance Parse (RefQualifier, White) where parse = (<?> "ref-qualifier") $ ((,) Rvalue . op AmperAmper) <|> ((,) Lvalue . op Amper)
  instance Parse PtrOperator where autoname_parse = auto2 PtrOperator_Ptr <|> PtrOperator_Ref . parse <|> auto4 PtrOperator_Nested
  instance Parse PtrAbstractDeclarator where parse = auto2 PtrAbstractDeclarator <|> PtrAbstractDeclarator_NoptrAbstractDeclarator . parse
  instance Parse NoptrAbstractDeclarator where parse = liftM2 (foldl $ NoptrAbstractDeclarator . Just) ((NoptrAbstractDeclarator_PtrAbstractDeclarator . parse) <|> NoptrAbstractDeclarator Nothing . parse) (many parse)
  instance Parse AbstractDeclarator where autoname_parse = auto1 AbstractDeclarator_PtrAbstractDeclarator
  instance Parse InitializerList where autoname_parse = auto1 InitializerList
  instance Parse InitializerClause where autoname_parse = auto1 InitializerClause
  instance Parse InitDeclaratorList where autoname_parse = auto1 InitDeclaratorList
  instance Parse InitDeclarator where
    autoname_parse = do
      declarator ← parse
      if is_pointer_or_reference declarator
        then InitDeclarator declarator . optionMaybe ((<?> "initializer") $ Initializer_Parenthesized . parseParenthesized (Enclosed . ExpressionList . InitializerList . flip Commad [] . parse) <|> auto1 Initializer_BraceOrEqualInitializer)
        else auto1 (InitDeclarator declarator)
  
  instance Parse Declarator where
    autoname_parse = auto1 Declarator_PtrDeclarator <|> auto3 Declarator_TrailingReturnType
  instance Parse PtrDeclarator where autoname_parse = liftM2 (flip $ foldl $ flip PtrDeclarator) (reverse . parse) (PtrDeclarator_NoptrDeclarator . parse)
  
  instance Parse NoptrDeclarator where
    parse = liftM2 (foldl f :: NoptrDeclarator -> [Either ParametersAndQualifiers (Squared (Maybe ConstantExpression))] -> NoptrDeclarator) (NoptrDeclarator_Parenthesized . parse <|> NoptrDeclarator_Id . parse) parse
     where f d = either (NoptrDeclarator_WithParams d) (NoptrDeclarator_Squared d)
  
  instance Parse DeclaratorId where autoname_parse = auto2 DeclaratorId_IdExpression
    -- We don't even try to parse a DeclaratorId_Nested, because we can't tell it apart from an IdExpression anyway.
  
  instance Parse TypeId where autoname_parse = typeP id (\x y → TypeId (TypeSpecifierSeq x) $ AbstractDeclarator_PtrAbstractDeclarator . y)
  
  typeP :: (Parse c, Convert b (Maybe (CvQualifier, White)), Convert TypeSpecifier b, ParseSpecifier b) ⇒
    (Maybe PtrAbstractDeclarator → c) → (NeList b → c → a) → Parser Char a
  typeP g h = makeTypeExtensions . parseOptions >>= \b → flip fix [] $ \self specs → do
      pspec ← parsePrimarySpec; sspecs ← many parseSecondarySpec
      let (p, q) = neElim $ NeList.reverse $ pspec :| specs
      r ← parse
      return $ h (p :| (q ++ sspecs)) r
     <|> (((: specs) . parseSecondarySpec) >>= self)
     <|> if not b then pzero else do
      let (noncvs, cvs) = partitionMaybe (\x → convert x :: Maybe (CvQualifier, White)) specs
      (x, y) ← apply (map fst cvs) . type_desc
      return $ uncurry h $ second g $ case y of
        Left s → (prefixNeList noncvs (fmap convert $ with_default (s:x)), Nothing)
        Right ad → (prefixNeList noncvs (fmap convert $ with_default x), Just ad)
  
  instance Parse Initializer where autoname_parse = auto1 Initializer_Parenthesized <|> auto1 Initializer_BraceOrEqualInitializer
  instance Parse BraceOrEqualInitializer where autoname_parse = auto2 EqualInitializer <|> auto1 BraceInitializer
  instance Parse BracedInitList where autoname_parse = auto1 BracedInitList
  instance Parse ParametersAndQualifiers where autoname_parse = memoize $ auto4 ParametersAndQualifiers
    {- This memoize prevents an exponential explosion in
        { 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)))))))))))))))))))))))); }
    -}
  
  instance Parse TrailingReturnType where autoname_parse = auto3 TrailingReturnType
  
  instance Parse ParameterDeclarationClause where
    autoname_parse =
      ParameterDeclarationClause Nothing . Just . parse <|> (do
        l ← parse
        auto2 (ParameterDeclarationClauseWithEllipsis l) <|> ParameterDeclarationClause (Just l) . parse
        ) <|> return (ParameterDeclarationClause Nothing Nothing)
  
  instance Parse ParameterDeclarationList where autoname_parse = auto1 ParameterDeclarationList
  instance Parse ParameterDeclaration where autoname_parse = typeP (Right . (AbstractDeclarator_PtrAbstractDeclarator .)) (ParameterDeclaration . DeclSpecifierSeq) >>= auto1
  
  -- 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.
  -- 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.
  -- 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).
  
  class ParseSpecifier s where parsePrimarySpec, parseSecondarySpec :: Parser Char s
  
  instance ParseSpecifier TrailingTypeSpecifier where
    parsePrimarySpec = (<?> "trailing-type-specifier") $ TrailingTypeSpecifier_SimpleTypeSpecifier . primarySimpleTypeSpecifier <|> TrailingTypeSpecifier_TypenameSpecifier . parse <|> TrailingTypeSpecifier_ElaboratedTypeSpecifier . parse
    parseSecondarySpec = (<?> "trailing-type-specifier") $ TrailingTypeSpecifier_CvQualifier . parse <|> TrailingTypeSpecifier_SimpleTypeSpecifier . LengthSpec . parse <|> TrailingTypeSpecifier_SimpleTypeSpecifier . SignSpec . parse <|> TrailingTypeSpecifier_SimpleTypeSpecifier . SimpleTypeSpecifier_BasicType . parse
  
  instance ParseSpecifier TypeSpecifier where
    parsePrimarySpec = (<?> "type-specifier") $ TypeSpecifier_ClassSpecifier . parse <|> TypeSpecifier_TrailingTypeSpecifier . parsePrimarySpec <|> TypeSpecifier_EnumSpecifier . parse
    parseSecondarySpec = (<?> "type-specifier") $ TypeSpecifier_TrailingTypeSpecifier . parseSecondarySpec
  
  instance ParseSpecifier DeclSpecifier where
    parsePrimarySpec = DeclSpecifier_TypeSpecifier . parsePrimarySpec
    parseSecondarySpec = DeclSpecifier_StorageClassSpecifier . parse <|> DeclSpecifier_FunctionSpecifier . parse <|> DeclSpecifier_Friend . parse <|> DeclSpecifier_Typedef . parse <|> DeclSpecifier_ConstExpr . parse <|> DeclSpecifier_AlignmentSpecifier . parse <|> DeclSpecifier_TypeSpecifier . parseSecondarySpec
  
  primarySimpleTypeSpecifier :: Parser Char SimpleTypeSpecifier
  primarySimpleTypeSpecifier = (<?> "simple-type-specifier") $ SimpleTypeSpecifier_BasicType . parse
    <|> auto2 SimpleTypeSpecifier_DeclType <|> auto2 SimpleTypeSpecifier_TypeName <|> auto1 LengthSpec <|> auto1 SignSpec <|> auto1 SimpleTypeSpecifier_Auto
  
  instance ParseSpecifier MakeSpecifier where
    parsePrimarySpec = (<?> "make-specifier") $ MakeSpecifier_DeclSpecifier . parsePrimarySpec
    parseSecondarySpec = (<?> "make-specifier") $
      (symbols "non" >> NonFunctionSpecifier . fst . (parse :: Parser Char (FunctionSpecifier, White))) <|>
      (symbols "non" >> NonStorageClassSpecifier . fst . (parse :: Parser Char (StorageClassSpecifier, White))) <|>
      (symbols "non" >> NonCv . fst . (parse :: Parser Char (CvQualifier, White))) <|>
      (symbols "non" >> NonSign . fst . (parse :: Parser Char (Sign, White))) <|>
      (symbols "non" >> NonLength . fst . (parse :: Parser Char (LengthSpec, White))) <|>
      (symbols "implicit" >> return (NonFunctionSpecifier Explicit)) <|>
      MakeSpecifier_DeclSpecifier . parseSecondarySpec
  
  instance Parse TypeSpecifierSeq where
    autoname_parse =
      TypeSpecifierSeq . (liftM2 (:|) parsePrimarySpec (many parseSecondarySpec) <|> liftM2 (:|) parseSecondarySpec lp)
      where lp = liftM2 (:) parsePrimarySpec (many parseSecondarySpec) <|> liftM2 (:) parseSecondarySpec lp <|> return []
  
  instance Parse TrailingTypeSpecifierSeq where autoname_parse = auto1 TrailingTypeSpecifierSeq
  
  instance Parse DeclSpecifier where autoname_parse = parsePrimarySpec <|> parseSecondarySpec
  
  instance Parse FunctionDefinition where
    autoname_parse = do
      (declspecs, (declarator, body)) ← manyTill parse (liftM2 (,) parse parse)
      return $ FunctionDefinition (convert (declspecs :: [DeclSpecifier])) declarator body
  
  instance Parse FunctionBody where autoname_parse = auto2 FunctionBody <|> auto1 FunctionBody_FunctionTryBlock <|> auto3 DefaultedFunctionBody <|> auto3 DeletedFunctionBody
  
  -- A.8 Classes [gram.class]
  
  instance Parse ClassSpecifier where autoname_parse = auto2 ClassSpecifier
  instance Parse ClassHead where autoname_parse = auto3 ClassHead
  instance Parse ClassHeadKind where parse = auto2 ClassHeadKind_SimpleTemplateId <|> auto2 ClassHeadKind_NestedIdentifier <|> auto1 ClassHeadKind_Identifier
  instance Parse MemberSpecification where autoname_parse = auto1 MemberSpecification
  instance Parse MemberAccessSpecifier where autoname_parse = auto2 MemberAccessSpecifier
  instance Parse MemberDeclaration where
    autoname_parse = do
        (x, (y, z)) ← manyTill parse (liftM2 (,) parse parse)
        return $ MemberDeclaration (convert (x :: [DeclSpecifier])) y z
      <|> auto2 MemberFunctionDefinition <|> auto1 MemberUsingDeclaration <|> auto1 MemberTemplateDeclaration
  instance Parse MemberDeclaratorList where autoname_parse = auto1 MemberDeclaratorList
  instance Parse MemberDeclarator where autoname_parse = auto3 BitField <|> auto2 MemberDeclarator
  instance Parse PureSpecifier where autoname_parse = auto2 PureSpecifier
  
  -- A.9 Derived classes [gram.derived]
  
  instance Parse BaseSpecifierList where autoname_parse = auto1 BaseSpecifierList
  instance Parse BaseSpecifier where autoname_parse = auto3 BaseSpecifier
  instance Parse BaseClause where autoname_parse = auto2 BaseClause
  
  -- A.10 Special member functions [gram.special]
  
  instance Parse ConversionTypeId where autoname_parse = auto2 ConversionTypeId
  instance Parse CtorInitializer where autoname_parse = auto2 CtorInitializer
  instance Parse MemInitializerList where autoname_parse = auto1 MemInitializerList
  instance Parse MemInitializer where autoname_parse = auto2 MemInitializer
  instance Parse MemInitializerId where autoname_parse = auto2 MemInitializerId_ClassName <|> auto1 MemInitializerId_Identifier
  
  -- A.11 Overloading [gram.over]
  
  instance Parse OverloadableOperator where
    parse = (<?> "overloadable operator") $
      auto2 OverloadableOperator_New <|> auto2 OverloadableOperator_Delete <|>
      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
  
  instance Parse OperatorFunctionId where autoname_parse = auto2 OperatorFunctionId
  
  -- A.12 Templates [gram.temp]
  
  instance Parse TemplateArguments where autoname_parse = memoize $ auto1 TemplateArguments
  
  {- Consider the following code:
  
    {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; }
  
  At 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. -}
  
  instance Parse TemplateId where autoname_parse = auto2 TemplateId_OperatorFunctionId <|> auto1 TemplateId_SimpleTemplateId
  instance Parse TypenameSpecifier where autoname_parse = auto4 TypenameSpecifier
  instance Parse SimpleTemplateId where autoname_parse = auto2 SimpleTemplateId
  instance Parse TemplateArgumentList where autoname_parse = auto1 TemplateArgumentList
  instance Parse TemplateArgument where autoname_parse = auto1 TemplateArgument_TypeId <|> auto1 TemplateArgument_ConstantExpression <|> auto1 TemplateArgument_IdExpression
    -- Todo: There's probably potential for factoring here.
  instance Parse TemplateDeclaration where autoname_parse = auto4 TemplateDeclaration
  instance Parse TemplateParameterList where autoname_parse = auto1 TemplateParameterList
  instance Parse TemplateParameter where autoname_parse = auto1 TemplateParameter_TypeParameter <|> auto1 TemplateParameter_ParameterDeclaration
  instance Parse TypeParameter where autoname_parse = auto3 TypeParameter_Class <|> auto5 TypeParameter_Template
  instance Parse ExplicitInstantiation where autoname_parse = auto3 ExplicitInstantiation
  instance Parse ExplicitSpecialization where autoname_parse = auto3 ExplicitSpecialization
  
  -- A.13 Exception handling [gram.except]
  
  instance Parse ExceptionSpecification where autoname_parse = auto2 ExceptionSpecification
  instance Parse TypeIdList where autoname_parse = auto1 TypeIdList
  instance Parse TryBlock where autoname_parse = auto3 TryBlock
  instance Parse FunctionTryBlock where autoname_parse = auto4 FunctionTryBlock
  instance Parse HandlerSeq where autoname_parse = auto1 HandlerSeq
  instance Parse Handler where autoname_parse = auto3 Handler
  instance Parse ExceptionDeclaration where autoname_parse = auto1 ExceptionDeclaration_Ellipsis <|> auto2 ExceptionDeclaration
  
  -- A.14 Preprocessing directives [gram.cpp]
  