{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Sql.Ansi where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Grammars
import Hydra.Tools.GrammarToModule
import qualified Hydra.Dsl.Annotations as Ann
import qualified Hydra.Grammar as G

import qualified Data.List as L


sqlModule :: Module
sqlModule :: Module
sqlModule = Namespace -> Grammar -> Maybe [Char] -> Module
grammarToModule Namespace
ns Grammar
sqlGrammar (Maybe [Char] -> Module) -> Maybe [Char] -> Module
forall a b. (a -> b) -> a -> b
$
    [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
"A subset of ANSI SQL:2003, capturing selected productions of the BNF grammar provided at "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"https://ronsavage.github.io/SQL/sql-2003-2.bnf.html, which is based on "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"the Final Committee Draft (FCD) of ISO/IEC 9075-2:2003")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/langs/sql/ansi"

sqlGrammar :: G.Grammar
sqlGrammar :: Grammar
sqlGrammar = [Production] -> Grammar
G.Grammar ([Production] -> Grammar) -> [Production] -> Grammar
forall a b. (a -> b) -> a -> b
$ [Production]
tokens [Production] -> [Production] -> [Production]
forall a. [a] -> [a] -> [a]
++ [Production]
productions

tokens :: [G.Production]
tokens :: [Production]
tokens = [
    -- <approximate numeric literal>    ::=   <mantissa> E <exponent>
    [Char] -> [Pattern] -> Production
define [Char]
"ApproximateNumericLiteral" [[Char] -> Pattern
regex ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [Char]
mantissa [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"E" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
exponent],

    -- <binary string literal>    ::=
    --         X <quote> [ { <hexit> <hexit> }... ] <quote>
    --         [ { <separator> <quote> [ { <hexit> <hexit> }... ] <quote> }... ]
    --         [ ESCAPE <escape character> ]
    [Char] -> [Pattern] -> Production
define [Char]
"BinaryStringLiteral" [Pattern]
unsupported,

    -- <character string literal>    ::=
    --         [ <introducer> <character set specification> ]
    --         <quote> [ <character representation> ... ] <quote>
    --         [ { <separator> <quote> [ <character representation> ... ] <quote> }... ]
    [Char] -> [Pattern] -> Production
define [Char]
"CharacterStringLiteral" [[Char] -> Pattern
regex ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$
      [Char] -> [Char]
opt([Char]
introducer [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
characterSetSpecification)
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quote [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
star([Char]
characterRepresentation) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quote
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
star([Char]
separator [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quote [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
star([Char]
characterRepresentation) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quote)],

    -- <column name>    ::=   <identifier>
    [Char] -> [Pattern] -> Production
define [Char]
"ColumnName" [[Char] -> Pattern
regex [Char]
identifier],

    -- <date string>    ::=   <quote> <unquoted date string> <quote>
    [Char] -> [Pattern] -> Production
define [Char]
"DateString" [Pattern]
unsupported,

    -- <domain name>    ::=   <schema qualified name>
    [Char] -> [Pattern] -> Production
define [Char]
"DomainName" [[Char] -> Pattern
regex [Char]
schemaQualifiedName],

    -- <exact numeric literal>    ::=
         --         <unsigned integer> [ <period> [ <unsigned integer> ] ]
         --     |     <period> <unsigned integer>
    [Char] -> [Pattern] -> Production
define [Char]
"ExactNumericLiteral" [[Char] -> Pattern
regex ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
or [
      [Char]
unsignedInteger [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
opt ([Char]
period [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unsignedInteger),
      [Char]
period [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unsignedInteger]],

    -- <left bracket or trigraph>    ::=   <left bracket> | <left bracket trigraph>
    [Char] -> [Pattern] -> Production
define [Char]
"LeftBracketOrTrigraph" [[Char] -> Pattern
regex ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
or [[Char]
leftBracket, [Char]
leftBracketTrigraph]],

    -- <right bracket or trigraph>    ::=   <right bracket> | <right bracket trigraph>
    [Char] -> [Pattern] -> Production
define [Char]
"RightBracketOrTrigraph" [[Char] -> Pattern
regex ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
or [[Char]
rightBracket, [Char]
rightBracketTrigraph]],

    -- <national character string literal>    ::=
    --         N <quote> [ <character representation> ... ] <quote>
    --         [ { <separator> <quote> [ <character representation> ... ] <quote> }... ]
    [Char] -> [Pattern] -> Production
define [Char]
"NationalCharacterStringLiteral" [Pattern]
unsupported,

    -- <path-resolved user-defined type name>    ::=   <user-defined type name>
    [Char] -> [Pattern] -> Production
define [Char]
"PathResolvedUserDefinedTypeName" [[Char] -> Pattern
regex [Char]
userDefinedTypeName],

    -- <table name>    ::=   <local or schema qualified name>
    [Char] -> [Pattern] -> Production
define [Char]
"TableName" [[Char] -> Pattern
regex [Char]
localOrSchemaQualifiedName],

    -- <time string>    ::=   <quote> <unquoted time string> <quote>
    [Char] -> [Pattern] -> Production
define [Char]
"TimeString" [Pattern]
unsupported,

    -- <timestamp string>    ::=   <quote> <unquoted timestamp string> <quote>
    [Char] -> [Pattern] -> Production
define [Char]
"TimestampLiteral" [Pattern]
unsupported,

    -- <Unicode character string literal>    ::=
    --         [ <introducer> <character set specification> ]
    --         U <ampersand> <quote> [ <Unicode representation> ... ] <quote>
    --         [ { <separator> <quote> [ <Unicode representation> ... ] <quote> }... ]
    --         [ ESCAPE <escape character> ]
    [Char] -> [Pattern] -> Production
define [Char]
"UnicodeCharacterStringLiteral" [Pattern]
unsupported,

    -- <unsigned integer>    ::=   <digit> ...
    [Char] -> [Pattern] -> Production
define [Char]
"UnsignedInteger" [[Char] -> Pattern
regex [Char]
unsignedInteger]]
  where
    opt :: [Char] -> [Char]
opt [Char]
pat = [Char] -> [Char]
par [Char]
pat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"?"
    or :: [[Char]] -> [Char]
or [[Char]]
pats = [Char] -> [Char]
par ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"|" ([Char] -> [Char]
par ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
pats)
    par :: [Char] -> [Char]
par [Char]
pat = [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
    plus :: [Char] -> [Char]
plus [Char]
pat = [Char] -> [Char]
par [Char]
pat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"+"
    star :: [Char] -> [Char]
star [Char]
pat = [Char] -> [Char]
par [Char]
pat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"*"

    -- <actual identifier>    ::=   <regular identifier> | <delimited identifier>
    actualIdentifier :: [Char]
actualIdentifier = [Char]
regularIdentifier -- Note: this is a simplification

    -- <asterisk>    ::=   *
    asterisk :: [Char]
asterisk = [Char]
"*"

    -- <bracketed comment>    ::=
    --         <bracketed comment introducer> <bracketed comment contents> <bracketed comment terminator>
    bracketedComment :: [Char]
bracketedComment = [Char]
bracketedCommentIntroducer [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bracketedCommentContents [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bracketedCommentTerminator

    -- <bracketed comment contents>    ::=   [ { <comment character> | <separator> }... ]
    bracketedCommentContents :: [Char]
bracketedCommentContents = [Char] -> [Char]
star ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
or [[Char]
commentCharacter, [Char]
separator]

    -- <bracketed comment introducer>    ::=   <slash> <asterisk>
    bracketedCommentIntroducer :: [Char]
bracketedCommentIntroducer = [Char]
slash [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
asterisk

    -- <bracketed comment terminator>    ::=   <asterisk> <slash>
    bracketedCommentTerminator :: [Char]
bracketedCommentTerminator = [Char]
asterisk [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
slash

    -- <catalog name>    ::=   <identifier>
    catalogName :: [Char]
catalogName = [Char]
identifier

    -- <character representation>    ::=   <nonquote character> | <quote symbol>
    characterRepresentation :: [Char]
characterRepresentation = [[Char]] -> [Char]
or [[Char]
nonquoteCharacter, [Char]
quoteSymbol]

    -- <character set specification>    ::=
    --         <standard character set name>
    --     |     <implementation-defined character set name>
    --     |     <user-defined character set name>
    characterSetSpecification :: [Char]
characterSetSpecification = [Char]
"" -- TODO

    -- <comment>    ::=   <simple comment> | <bracketed comment>
    comment :: [Char]
comment = [[Char]] -> [Char]
or[[Char]
simpleComment, [Char]
bracketedComment]

    -- <comment character>    ::=   <nonquote character> | <quote>
    commentCharacter :: [Char]
commentCharacter = [[Char]] -> [Char]
or [[Char]
nonquoteCharacter, [Char]
quote]

    -- <digit>    ::=   0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
    digit :: [Char]
digit = [Char]
"[0-9]"

    -- <exact numeric literal>    ::=
    --         <unsigned integer> [ <period> [ <unsigned integer> ] ]
    --     |     <period> <unsigned integer>
    exactNumericLiteral :: [Char]
exactNumericLiteral = [[Char]] -> [Char]
or [
      [Char]
unsignedInteger [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
opt ([Char]
period [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
opt [Char]
unsignedInteger),
      [Char]
period [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unsignedInteger]

    -- <exponent>    ::=   <signed integer>
    exponent :: [Char]
exponent = [Char]
signedInteger

    -- <identifier>    ::=   <actual identifier>
    identifier :: [Char]
identifier = [Char]
actualIdentifier

    -- <identifier body>    ::=   <identifier start> [ <identifier part> ... ]
    identifierBody :: [Char]
identifierBody = [Char]
identifierStart [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
star [Char]
identifierPart

    -- <identifier extend>    ::=   !! See the Syntax Rules.
    identifierExtend :: [Char]
identifierExtend = [Char]
"[0-9_]" -- TODO

    -- <identifier part>    ::=   <identifier start> | <identifier extend>
    identifierPart :: [Char]
identifierPart = [[Char]] -> [Char]
or [[Char]
identifierStart, [Char]
identifierExtend]

    -- <identifier start>    ::=   !! See the Syntax Rules.
    identifierStart :: [Char]
identifierStart = [Char]
"[A-Za-z]" -- TODO

    -- <introducer>    ::=   <underscore>
    introducer :: [Char]
introducer = [Char]
underscore

    -- <left bracket>    ::=   [
    leftBracket :: [Char]
leftBracket = [Char]
"["

    -- <left bracket trigraph>    ::=   ??(
    leftBracketTrigraph :: [Char]
leftBracketTrigraph = [Char]
"??("

    -- <local or schema qualifier>    ::=   <schema name> | MODULE
    localOrSchemaQualifier :: [Char]
localOrSchemaQualifier = [[Char]] -> [Char]
or [[Char]
schemaName, [Char]
"MODULE"]

    -- <local or schema qualified name>    ::=   [ <local or schema qualifier> <period> ] <qualified identifier>
    localOrSchemaQualifiedName :: [Char]
localOrSchemaQualifiedName = [Char] -> [Char]
opt ([Char]
localOrSchemaQualifier [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
period) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
qualifiedIdentifier

    -- <mantissa>    ::=   <exact numeric literal>
    mantissa :: [Char]
mantissa = [Char]
exactNumericLiteral

    -- <minus sign>    ::=   -
    minusSign :: [Char]
minusSign = [Char]
"-"

    -- <newline>    ::=   !! See the Syntax Rules.
    newline :: [Char]
newline = [Char]
"[\\n]" -- TODO

    -- <nonquote character>    ::=   !! See the Syntax Rules.
    nonquoteCharacter :: [Char]
nonquoteCharacter = [Char]
"[ -&(-~]" -- TODO

    -- <period>    ::=   .
    period :: [Char]
period = [Char]
"[.]"

    -- <plus sign>    ::=   +
    plusSign :: [Char]
plusSign = [Char]
"+"

    -- <quote>    ::=   '
    quote :: [Char]
quote = [Char]
"'"

    -- <quote symbol>    ::=   <quote> <quote>
    quoteSymbol :: [Char]
quoteSymbol = [Char]
quote [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quote

    -- <qualified identifier>    ::=   <identifier>
    qualifiedIdentifier :: [Char]
qualifiedIdentifier = [Char]
identifier

    -- <regular identifier>    ::=   <identifier body>
    regularIdentifier :: [Char]
regularIdentifier = [Char]
identifierBody

    -- <right bracket>    ::=   ]
    rightBracket :: [Char]
rightBracket = [Char]
"]"

    -- <right bracket trigraph>    ::=   ??)
    rightBracketTrigraph :: [Char]
rightBracketTrigraph = [Char]
"??)"

    -- <separator>    ::=   { <comment> | <white space> }...
    separator :: [Char]
separator = [Char] -> [Char]
star([[Char]] -> [Char]
or[[Char]
comment, [Char]
whiteSpace])

    -- <schema name>    ::=   [ <catalog name> <period> ] <unqualified schema name>
    schemaName :: [Char]
schemaName = [Char] -> [Char]
opt ([Char]
catalogName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
period) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unqualifiedSchemaName

    -- <schema qualified name>    ::=   [ <schema name> <period> ] <qualified identifier>
    schemaQualifiedName :: [Char]
schemaQualifiedName = [Char] -> [Char]
opt ([Char]
schemaName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
period) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
qualifiedIdentifier

    -- <schema qualified type name>    ::=   [ <schema name> <period> ] <qualified identifier>
    schemaQualifiedTypeName :: [Char]
schemaQualifiedTypeName = [Char] -> [Char]
opt ([Char]
schemaName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
period) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
qualifiedIdentifier

    -- <sign>    ::=   <plus sign> | <minus sign>
    sign :: [Char]
sign = [[Char]] -> [Char]
or [[Char]
plusSign, [Char]
minusSign]

    -- <signed integer>    ::=   [ <sign> ] <unsigned integer>
    signedInteger :: [Char]
signedInteger = [Char] -> [Char]
opt [Char]
sign [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unsignedInteger

    -- <simple comment>    ::=   <simple comment introducer> [ <comment character> ... ] <newline>
    simpleComment :: [Char]
simpleComment = [Char]
simpleCommentIntroducer [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
star([Char]
commentCharacter) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newline

    -- <simple comment introducer>    ::=   <minus sign> <minus sign> [ <minus sign> ... ]
    simpleCommentIntroducer :: [Char]
simpleCommentIntroducer = [Char]
minusSign [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
plus([Char]
minusSign)

    slash :: [Char]
slash = [Char]
"/"

    -- <underscore>    ::=   _
    underscore :: [Char]
underscore = [Char]
"_"

    -- <unqualified schema name> ::= <schema name>
    unqualifiedSchemaName :: [Char]
unqualifiedSchemaName = [Char]
schemaName

    -- <unsigned integer>    ::=   <digit> ...
    unsignedInteger :: [Char]
unsignedInteger = [Char] -> [Char]
plus [Char]
digit

    -- <user-defined type name>    ::=   <schema qualified type name>
    userDefinedTypeName :: [Char]
userDefinedTypeName = [Char]
schemaQualifiedTypeName

    whiteSpace :: [Char]
whiteSpace = [Char]
"[ \\t]" -- TODO

productions :: [G.Production]
productions :: [Production]
productions = [
  -- <approximate numeric type>    ::=
       --         FLOAT [ <left paren> <precision> <right paren> ]
       --     |     REAL
       --     |     DOUBLE PRECISION
  [Char] -> [Pattern] -> Production
define [Char]
"ApproximateNumericType" [
    [Char]
"float"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
float_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"Precision"])],
    [Char]
"real"[Char] -> Pattern -> Pattern
>: Pattern
real_,
    [Char]
"double"[Char] -> Pattern -> Pattern
>: Pattern
double_precision_],

  -- <array element>    ::=   <value expression>
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayElement" [
    Pattern
"ValueExpression"],

  -- <array element list>    ::=   <array element> [ { <comma> <array element> }... ]
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayElementList" [Pattern -> Pattern
commaList Pattern
"ArrayElement"],

  -- <array element reference>    ::=
  --         <array value expression> <left bracket or trigraph> <numeric value expression> <right bracket or trigraph>
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayElementReference" [Pattern]
unsupported,

  -- <array type>    ::=   <data type> ARRAY [ <left bracket or trigraph> <unsigned integer> <right bracket or trigraph> ]
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayType" [Pattern]
unsupported,

  -- <array value constructor>    ::=
  --         <array value constructor by enumeration>
  --     |     <array value constructor by query>
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayValueConstructor" [
    [Char]
"enumeration"[Char] -> Pattern -> Pattern
>: Pattern
"ArrayValueConstructorByEnumeration",
    [Char]
"query"[Char] -> Pattern -> Pattern
>: Pattern
"ArrayValueConstructorByQuery"],

  -- <array value constructor by query>    ::=
  --         ARRAY <left paren> <query expression> [ <order by clause> ] <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayValueConstructorByQuery" [Pattern]
unsupported,

  -- <array value constructor by enumeration>    ::=
  --         ARRAY <left bracket or trigraph> <array element list> <right bracket or trigraph>
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayValueConstructorByEnumeration" [
    [Pattern] -> Pattern
list[Pattern
array_, Pattern
"LeftBracketOrTrigraph", Pattern
"ArrayElementList", Pattern
"RightBracketOrTrigraph"]],

  -- <array value expression>    ::=   <array concatenation> | <array factor>
  [Char] -> [Pattern] -> Production
define [Char]
"ArrayValueExpression" [Pattern]
unsupported,

  -- <as subquery clause>    ::=   [ <left paren> <column name list> <right paren> ] AS <subquery> <with or without data>
  [Char] -> [Pattern] -> Production
define [Char]
"AsSubqueryClause" [Pattern]
unsupported,

  -- <attribute or method reference>    ::=
  --         <value expression primary> <dereference operator> <qualified identifier>
  --         [ <SQL argument list> ]
  [Char] -> [Pattern] -> Production
define [Char]
"AttributeOrMethodReference" [Pattern]
unsupported,

  -- <binary large object string type>    ::=
  --         BINARY LARGE OBJECT [ <left paren> <large object length> <right paren> ]
  --     |     BLOB [ <left paren> <large object length> <right paren> ]
  [Char] -> [Pattern] -> Production
define [Char]
"BinaryLargeObjectStringType" [
    [Char]
"binary"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
binary_large_object_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"LargeObjectLength"])],
    [Char]
"blob"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
blob_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"LargeObjectLength"])]],

  -- <boolean factor>    ::=   [ NOT ] <boolean test>
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanFactor" [
    [Pattern] -> Pattern
list[Pattern -> Pattern
opt(Pattern
not_), Pattern
"BooleanTest"]],

  -- <boolean literal>    ::=   TRUE | FALSE | UNKNOWN
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanLiteral" [
    Pattern
true_,
    Pattern
false_,
    Pattern
unknown_],

  -- <boolean predicand>    ::=
  --         <parenthesized boolean value expression>
  --     |     <nonparenthesized value expression primary>
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanPredicand" [Pattern]
unsupported,

  -- <boolean primary>    ::=   <predicate> | <boolean predicand>
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanPrimary" [
    [Char]
"predicate"[Char] -> Pattern -> Pattern
>: Pattern
"Predicate",
    [Char]
"predicand"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanPredicand"],

  -- <boolean term>    ::=
  --         <boolean factor>
  --     |     <boolean term> AND <boolean factor>
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanTerm" [
    [Char]
"factor"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanFactor",
    [Char]
"and"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[
      [Char]
"lhs"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanTerm",
      Pattern
and_,
      [Char]
"rhs"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanFactor"]],

  -- <boolean test>    ::=   <boolean primary> [ IS [ NOT ] <truth value> ]
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanTest" [
    [Pattern] -> Pattern
list[Pattern
"BooleanPrimary", Pattern -> Pattern
opt([Pattern] -> Pattern
list[Pattern
is_, Pattern -> Pattern
opt(Pattern
not_), Pattern
"TruthValue"])]],

  -- <boolean type>    ::=   BOOLEAN
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanType" [
    Pattern
boolean_],

  -- <boolean value expression>    ::=
  --         <boolean term>
  --     |     <boolean value expression> OR <boolean term>
  [Char] -> [Pattern] -> Production
define [Char]
"BooleanValueExpression" [
    [Char]
"term"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanTerm",
    [Char]
"or"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[
      [Char]
"lhs"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanValueExpression",
      Pattern
or_,
      [Char]
"rhs"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanTerm"]],

  -- <case expression>    ::=   <case abbreviation> | <case specification>
  [Char] -> [Pattern] -> Production
define [Char]
"CaseExpression" [Pattern]
unsupported,

  -- <cast specification>    ::=   CAST <left paren> <cast operand> AS <cast target> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"CastSpecification" [Pattern]
unsupported,

  -- <character set specification>    ::=
  --         <standard character set name>
  --     |     <implementation-defined character set name>
  --     |     <user-defined character set name>
  [Char] -> [Pattern] -> Production
define [Char]
"CharacterSetSpecification" [Pattern]
unsupported,

  -- <character string type>    ::=
  --         CHARACTER [ <left paren> <length> <right paren> ]
  --     |     CHAR [ <left paren> <length> <right paren> ]
  --     |     CHARACTER VARYING <left paren> <length> <right paren>
  --     |     CHAR VARYING <left paren> <length> <right paren>
  --     |     VARCHAR <left paren> <length> <right paren>
  --     |     CHARACTER LARGE OBJECT [ <left paren> <large object length> <right paren> ]
  --     |     CHAR LARGE OBJECT [ <left paren> <large object length> <right paren> ]
  --     |     CLOB [ <left paren> <large object length> <right paren> ]
  [Char] -> [Pattern] -> Production
define [Char]
"CharacterStringType" [
    [Char]
"character"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
character_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"Length"])],
    [Char]
"char"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
char_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"Length"])],
    [Char]
"characterVarying"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
character_varying_, Pattern
left_paren_, Pattern
"Length", Pattern
right_paren_],
    [Char]
"charVarying"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
char_varying_, Pattern
left_paren_, Pattern
"Length", Pattern
right_paren_],
    [Char]
"varchar"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
varchar_, Pattern
left_paren_, Pattern
"Length", Pattern
right_paren_],
    [Char]
"characterLargeObject"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
character_large_object_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"LargeObjectLength"])],
    [Char]
"charLargeObject"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
char_large_object_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"LargeObjectLength"])],
    [Char]
"clob"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
clob_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"LargeObjectLength"])]],

  -- <collate clause>    ::=   COLLATE <collation name>
  [Char] -> [Pattern] -> Production
define [Char]
"CollateClause" [Pattern]
unsupported,

  -- <collection type>    ::=   <array type> | <multiset type>
  [Char] -> [Pattern] -> Production
define [Char]
"CollectionType" [
    [Char]
"array"[Char] -> Pattern -> Pattern
>: Pattern
"ArrayType",
    [Char]
"multiset"[Char] -> Pattern -> Pattern
>: Pattern
"MultisetType"],

  -- <collection value constructor>    ::=   <array value constructor> | <multiset value constructor>
  [Char] -> [Pattern] -> Production
define [Char]
"CollectionValueConstructor" [
    [Char]
"array"[Char] -> Pattern -> Pattern
>: Pattern
"ArrayValueConstructor",
    [Char]
"multiset"[Char] -> Pattern -> Pattern
>: Pattern
"MultisetValueConstructor"],

  -- <collection value expression>    ::=   <array value expression> | <multiset value expression>
  [Char] -> [Pattern] -> Production
define [Char]
"CollectionValueExpression" [
    [Char]
"array"[Char] -> Pattern -> Pattern
>: Pattern
"ArrayValueExpression",
    [Char]
"multiset"[Char] -> Pattern -> Pattern
>: Pattern
"MultisetValueExpression"],

  -- <column constraint definition>    ::=   [ <constraint name definition> ] <column constraint> [ <constraint characteristics> ]
  [Char] -> [Pattern] -> Production
define [Char]
"ColumnConstraintDefinition" [Pattern]
unsupported,

  -- <column definition>    ::=
  --         <column name> [ <data type> | <domain name> ] [ <reference scope check> ]
  --         [ <default clause> | <identity column specification> | <generation clause> ]
  --         [ <column constraint definition> ... ] [ <collate clause> ]
  [Char] -> [Pattern] -> Production
define [Char]
"ColumnDefinition" [
    [Pattern] -> Pattern
list[
      [Char]
"name"[Char] -> Pattern -> Pattern
>: Pattern
"ColumnName",
      [Char]
"typeOrDomain"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
opt([Pattern] -> Pattern
alts[Pattern
"DataType", Pattern
"DomainName"]),
      [Char]
"refScope"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"ReferenceScopeCheck",
      [Char]
"defaultOrIdentityOrGeneration"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
opt([Pattern] -> Pattern
alts[Pattern
"DefaultClause", Pattern
"IdentityColumnSpecification", Pattern
"GenerationClause"]),
      [Char]
"constraints"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
starPattern
"ColumnConstraintDefinition",
      [Char]
"collate"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"CollateClause"]],

  -- <column name list>    ::=   <column name> [ { <comma> <column name> }... ]
  [Char] -> [Pattern] -> Production
define [Char]
"ColumnNameList" [Pattern -> Pattern
commaList Pattern
"ColumnName"],

  -- <column options>    ::=   <column name> WITH OPTIONS <column option list>
  [Char] -> [Pattern] -> Production
define [Char]
"ColumnOptions" [Pattern]
unsupported,

  -- <column reference>    ::=
       --         <basic identifier chain>
       --     |     MODULE <period> <qualified identifier> <period> <column name>
  [Char] -> [Pattern] -> Production
define [Char]
"ColumnReference" [Pattern]
unsupported,

  -- <common value expression>    ::=
  --         <numeric value expression>
  --     |     <string value expression>
  --     |     <datetime value expression>
  --     |     <interval value expression>
  --     |     <user-defined type value expression>
  --     |     <reference value expression>
  --     |     <collection value expression>
  [Char] -> [Pattern] -> Production
define [Char]
"CommonValueExpression" [
    [Char]
"numeric"[Char] -> Pattern -> Pattern
>: Pattern
"NumericValueExpression",
    [Char]
"string"[Char] -> Pattern -> Pattern
>: Pattern
"StringValueExpression",
    [Char]
"datetime"[Char] -> Pattern -> Pattern
>: Pattern
"DatetimeValueExpression",
    [Char]
"interval"[Char] -> Pattern -> Pattern
>: Pattern
"IntervalValueExpression",
    [Char]
"userDefined"[Char] -> Pattern -> Pattern
>: Pattern
"UserDefinedTypeValueExpression",
    [Char]
"reference"[Char] -> Pattern -> Pattern
>: Pattern
"ReferenceValueExpression",
    [Char]
"collection"[Char] -> Pattern -> Pattern
>: Pattern
"CollectionValueExpression"],

  -- <contextually typed row value expression>    ::=
  --         <row value special case>
  --     |     <contextually typed row value constructor>
  [Char] -> [Pattern] -> Production
define [Char]
"ContextuallyTypedRowValueExpression" [
    [Char]
"specialCase"[Char] -> Pattern -> Pattern
>: Pattern
"RowValueSpecialCase",
    [Char]
"constructor"[Char] -> Pattern -> Pattern
>: Pattern
"ContextuallyTypedRowValueConstructor"],

  -- <contextually typed row value constructor>    ::=
  --         <common value expression>
  --     |     <boolean value expression>
  --     |     <contextually typed value specification>
  --     |     <left paren> <contextually typed row value constructor element> <comma> <contextually typed row value constructor element list> <right paren>
  --     |     ROW <left paren> <contextually typed row value constructor element list> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"ContextuallyTypedRowValueConstructor" [Pattern]
unsupported,

  -- <contextually typed row value expression list>    ::=   <contextually typed row value expression> [ { <comma> <contextually typed row value expression> }... ]
  [Char] -> [Pattern] -> Production
define [Char]
"ContextuallyTypedRowValueExpressionList" [Pattern -> Pattern
commaList Pattern
"ContextuallyTypedRowValueExpression"],

  -- <contextually typed table value constructor>    ::=   VALUES <contextually typed row value expression list>
  [Char] -> [Pattern] -> Production
define [Char]
"ContextuallyTypedTableValueConstructor" [
    [Pattern] -> Pattern
list[Pattern
values_, Pattern
"ContextuallyTypedRowValueExpressionList"]],

  -- <data type>    ::=
  --         <predefined type>
  --     |     <row type>
  --     |     <path-resolved user-defined type name>
  --     |     <reference type>
  --     |     <collection type>
  [Char] -> [Pattern] -> Production
define [Char]
"DataType" [
    [Char]
"predefined"[Char] -> Pattern -> Pattern
>: Pattern
"PredefinedType",
    [Char]
"row"[Char] -> Pattern -> Pattern
>: Pattern
"RowType",
    [Char]
"named"[Char] -> Pattern -> Pattern
>: Pattern
"PathResolvedUserDefinedTypeName",
    [Char]
"reference"[Char] -> Pattern -> Pattern
>: Pattern
"ReferenceType",
    [Char]
"collection"[Char] -> Pattern -> Pattern
>: Pattern
"CollectionType"],

  -- <date literal>    ::=   DATE <date string>
  [Char] -> [Pattern] -> Production
define [Char]
"DateLiteral" [
    [Pattern] -> Pattern
list[Pattern
date_, Pattern
"DateString"]],

  -- <datetime literal>    ::=   <date literal> | <time literal> | <timestamp literal>
  [Char] -> [Pattern] -> Production
define [Char]
"DatetimeLiteral" [
    [Char]
"date"[Char] -> Pattern -> Pattern
>: Pattern
"DateLiteral",
    [Char]
"time"[Char] -> Pattern -> Pattern
>: Pattern
"TimeLiteral",
    [Char]
"timestamp"[Char] -> Pattern -> Pattern
>: Pattern
"TimestampLiteral"],

  -- <datetime type>    ::=
  --         DATE
  --     |     TIME [ <left paren> <time precision> <right paren> ] [ <with or without time zone> ]
  --     |     TIMESTAMP [ <left paren> <timestamp precision> <right paren> ] [ <with or without time zone> ]
  [Char] -> [Pattern] -> Production
define [Char]
"DatetimeType" [Pattern]
unsupported,

  -- <datetime value expression>    ::=
  --         <datetime term>
  --     |     <interval value expression> <plus sign> <datetime term>
  --     |     <datetime value expression> <plus sign> <interval term>
  --     |     <datetime value expression> <minus sign> <interval term>
  [Char] -> [Pattern] -> Production
define [Char]
"DatetimeValueExpression" [Pattern]
unsupported,

  -- <default clause>    ::=   DEFAULT <default option>
  [Char] -> [Pattern] -> Production
define [Char]
"DefaultClause" [Pattern]
unsupported,

  -- <exact numeric type>    ::=
  --         NUMERIC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]
  --     |     DECIMAL [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]
  --     |     DEC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]
  --     |     SMALLINT
  --     |     INTEGER
  --     |     INT
  --     |     BIGINT
  [Char] -> [Pattern] -> Production
define [Char]
"ExactNumericType" [
    [Char]
"numeric"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
numeric_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"Precision", Pattern -> Pattern
opt([Pattern] -> Pattern
list[Pattern
comma_, Pattern
"Scale"])])],
    [Char]
"decimal"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
decimal_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"Precision", Pattern -> Pattern
opt([Pattern] -> Pattern
list[Pattern
comma_, Pattern
"Scale"])])],
    [Char]
"dec"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[Pattern
dec_, Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"Precision", Pattern -> Pattern
opt([Pattern] -> Pattern
list[Pattern
comma_, Pattern
"Scale"])])],
    [Char]
"smallint"[Char] -> Pattern -> Pattern
>: Pattern
smallint_,
    [Char]
"integer"[Char] -> Pattern -> Pattern
>: Pattern
integer_,
    [Char]
"int"[Char] -> Pattern -> Pattern
>: Pattern
int_,
    [Char]
"bigint"[Char] -> Pattern -> Pattern
>: Pattern
bigint_],

  -- <field reference>    ::=   <value expression primary> <period> <field name>
  [Char] -> [Pattern] -> Production
define [Char]
"FieldReference" [Pattern]
unsupported,

  -- <from constructor>    ::=
  --         [ <left paren> <insert column list> <right paren> ] [ <override clause> ] <contextually typed table value constructor>
  [Char] -> [Pattern] -> Production
define [Char]
"FromConstructor" [
    [Pattern] -> Pattern
list[
      [Char]
"columns"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
opt([Pattern] -> Pattern
parens[Pattern
"InsertColumnList"]),
      [Char]
"override"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"OverrideClause",
      [Char]
"values"[Char] -> Pattern -> Pattern
>: Pattern
"ContextuallyTypedTableValueConstructor"]],

  -- <from default>    ::=   DEFAULT VALUES
  [Char] -> [Pattern] -> Production
define [Char]
"FromDefault" [
    Pattern
default_values_],

  -- <from subquery>    ::=   [ <left paren> <insert column list> <right paren> ] [ <override clause> ] <query expression>
  [Char] -> [Pattern] -> Production
define [Char]
"FromSubquery" [Pattern]
unsupported,

  -- <general literal>    ::=
  --         <character string literal>
  --     |     <national character string literal>
  --     |     <Unicode character string literal>
  --     |     <binary string literal>
  --     |     <datetime literal>
  --     |     <interval literal>
  --     |     <boolean literal>
  [Char] -> [Pattern] -> Production
define [Char]
"GeneralLiteral" [
    [Char]
"string"[Char] -> Pattern -> Pattern
>: Pattern
"CharacterStringLiteral",
    [Char]
"nationalString"[Char] -> Pattern -> Pattern
>: Pattern
"NationalCharacterStringLiteral",
    [Char]
"unicode"[Char] -> Pattern -> Pattern
>: Pattern
"UnicodeCharacterStringLiteral",
    [Char]
"binary"[Char] -> Pattern -> Pattern
>: Pattern
"BinaryStringLiteral",
    [Char]
"dateTime"[Char] -> Pattern -> Pattern
>: Pattern
"DatetimeLiteral",
    [Char]
"interval"[Char] -> Pattern -> Pattern
>: Pattern
"IntervalLiteral",
    [Char]
"boolean"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanLiteral"],

  -- <general value specification>    ::=
       --         <host parameter specification>
       --     |     <SQL parameter reference>
       --     |     <dynamic parameter specification>
       --     |     <embedded variable specification>
       --     |     <current collation specification>
       --     |     CURRENT_DEFAULT_TRANSFORM_GROUP
       --     |     CURRENT_PATH
       --     |     CURRENT_ROLE
       --     |     CURRENT_TRANSFORM_GROUP_FOR_TYPE <path-resolved user-defined type name>
       --     |     CURRENT_USER
       --     |     SESSION_USER
       --     |     SYSTEM_USER
       --     |     USER
       --     |     VALUE
  [Char] -> [Pattern] -> Production
define [Char]
"GeneralValueSpecification" [Pattern]
unsupported,

  -- <generation clause>    ::=   <generation rule> AS <generation expression>
  [Char] -> [Pattern] -> Production
define [Char]
"GenerationClause" [Pattern]
unsupported,

  -- <global or local>    ::=   GLOBAL | LOCAL
  [Char] -> [Pattern] -> Production
define [Char]
"GlobalOrLocal" [
    [Char]
"global"[Char] -> Pattern -> Pattern
>: Pattern
global_,
    [Char]
"local"[Char] -> Pattern -> Pattern
>: Pattern
local_],

  -- <identity column specification>    ::=
  --         GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY
  --         [ <left paren> <common sequence generator options> <right paren> ]
  [Char] -> [Pattern] -> Production
define [Char]
"IdentityColumnSpecification" [Pattern]
unsupported,

  -- <insert column list>    ::=   <column name list>
  [Char] -> [Pattern] -> Production
define [Char]
"InsertColumnList" [
    Pattern
"ColumnNameList"],

  -- <insert columns and source>    ::=
  --         <from subquery>
  --     |     <from constructor>
  --     |     <from default>
  [Char] -> [Pattern] -> Production
define [Char]
"InsertColumnsAndSource" [
    [Char]
"subquery"[Char] -> Pattern -> Pattern
>: Pattern
"FromSubquery",
    [Char]
"constructor"[Char] -> Pattern -> Pattern
>: Pattern
"FromConstructor",
    [Char]
"default"[Char] -> Pattern -> Pattern
>: Pattern
"FromDefault"],

  -- <insert statement>    ::=   INSERT INTO <insertion target> <insert columns and source>
  [Char] -> [Pattern] -> Production
define [Char]
"InsertStatement" [
    [Pattern] -> Pattern
list[
      Pattern
insert_into_,
      [Char]
"target"[Char] -> Pattern -> Pattern
>: Pattern
"InsertionTarget",
      [Char]
"columnsAndSource"[Char] -> Pattern -> Pattern
>: Pattern
"InsertColumnsAndSource"]],

  -- <insertion target>    ::=   <table name>
  [Char] -> [Pattern] -> Production
define [Char]
"InsertionTarget" [
    Pattern
"TableName"],

  -- <interval literal>    ::=   INTERVAL [ <sign> ] <interval string> <interval qualifier>
  [Char] -> [Pattern] -> Production
define [Char]
"IntervalLiteral" [Pattern]
unsupported,

  -- <interval type>    ::=   INTERVAL <interval qualifier>
  [Char] -> [Pattern] -> Production
define [Char]
"IntervalType" [Pattern]
unsupported,

  -- <interval value expression>    ::=
  --         <interval term>
  --     |     <interval value expression 1> <plus sign> <interval term 1>
  --     |     <interval value expression 1> <minus sign> <interval term 1>
  --     |     <left paren> <datetime value expression> <minus sign> <datetime term> <right paren> <interval qualifier>
  [Char] -> [Pattern] -> Production
define [Char]
"IntervalValueExpression" [Pattern]
unsupported,

  -- <large object length>    ::=
  --         <unsigned integer> [ <multiplier> ] [ <char length units> ]
  --     |     <large object length token> [ <char length units> ]
  [Char] -> [Pattern] -> Production
define [Char]
"LargeObjectLength" [Pattern]
unsupported,

  -- <length>    ::=   <unsigned integer>
  [Char] -> [Pattern] -> Production
define [Char]
"Length" [
      Pattern
"UnsignedInteger"],

  -- <like clause>    ::=   LIKE <table name> [ <like options> ]
  [Char] -> [Pattern] -> Production
define [Char]
"LikeClause" [Pattern]
unsupported,

  -- <method invocation>    ::=   <direct invocation> | <generalized invocation>
  [Char] -> [Pattern] -> Production
define [Char]
"MethodInvocation" [Pattern]
unsupported,

  -- <multiset element reference>    ::=
  --         ELEMENT <left paren> <multiset value expression> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"MultisetElementReference" [Pattern]
unsupported,

  -- <multiset type>    ::=   <data type> MULTISET
  [Char] -> [Pattern] -> Production
define [Char]
"MultisetType" [
    [Pattern] -> Pattern
list[Pattern
"DataType", Pattern
multiset_]],

  -- <multiset value constructor>    ::=
  --         <multiset value constructor by enumeration>
  --     |     <multiset value constructor by query>
  --     |     <table value constructor by query>
  [Char] -> [Pattern] -> Production
define [Char]
"MultisetValueConstructor" [Pattern]
unsupported,

  -- <multiset value expression>    ::=
  --         <multiset term>
  --     |     <multiset value expression> MULTISET UNION [ ALL | DISTINCT ] <multiset term>
  --     |     <multiset value expression> MULTISET EXCEPT [ ALL | DISTINCT ] <multiset term>
  [Char] -> [Pattern] -> Production
define [Char]
"MultisetValueExpression" [Pattern]
unsupported,

  -- <national character string type>    ::=
  --         NATIONAL CHARACTER [ <left paren> <length> <right paren> ]
  --     |     NATIONAL CHAR [ <left paren> <length> <right paren> ]
  --     |     NCHAR [ <left paren> <length> <right paren> ]
  --     |     NATIONAL CHARACTER VARYING <left paren> <length> <right paren>
  --     |     NATIONAL CHAR VARYING <left paren> <length> <right paren>
  --     |     NCHAR VARYING <left paren> <length> <right paren>
  --     |     NATIONAL CHARACTER LARGE OBJECT [ <left paren> <large object length> <right paren> ]
  --     |     NCHAR LARGE OBJECT [ <left paren> <large object length> <right paren> ]
  --     |     NCLOB [ <left paren> <large object length> <right paren> ]
  [Char] -> [Pattern] -> Production
define [Char]
"NationalCharacterStringType" [Pattern]
unsupported,

  -- <new specification>    ::=   NEW <routine invocation>
  [Char] -> [Pattern] -> Production
define [Char]
"NewSpecification" [Pattern]
unsupported,

  -- <next value expression>    ::=   NEXT VALUE FOR <sequence generator name>
  [Char] -> [Pattern] -> Production
define [Char]
"NextValueExpression" [Pattern]
unsupported,

  -- <numeric type>    ::=   <exact numeric type> | <approximate numeric type>
  [Char] -> [Pattern] -> Production
define [Char]
"NumericType" [
    [Char]
"exact"[Char] -> Pattern -> Pattern
>: Pattern
"ExactNumericType",
    [Char]
"approximate"[Char] -> Pattern -> Pattern
>: Pattern
"ApproximateNumericType"],

  -- <numeric value expression>    ::=
  --         <term>
  --     |     <numeric value expression> <plus sign> <term>
  --     |     <numeric value expression> <minus sign> <term>
  [Char] -> [Pattern] -> Production
define [Char]
"NumericValueExpression" [Pattern]
unsupported,

  -- <override clause>    ::=   OVERRIDING USER VALUE | OVERRIDING SYSTEM VALUE
  [Char] -> [Pattern] -> Production
define [Char]
"OverrideClause" [
    Pattern
overriding_user_value_,
    Pattern
overriding_system_value],

  -- <parenthesized value expression>    ::=   <left paren> <value expression> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"ParenthesizedValueExpression" [
    [Pattern] -> Pattern
parens[Pattern
"ValueExpression"]],

  -- <precision>    ::=   <unsigned integer>
  [Char] -> [Pattern] -> Production
define [Char]
"Precision" [
    Pattern
"UnsignedInteger"],

  -- <predefined type>    ::=
  --         <character string type> [ CHARACTER SET <character set specification> ] [ <collate clause> ]
  --     |     <national character string type> [ <collate clause> ]
  --     |     <binary large object string type>
  --     |     <numeric type>
  --     |     <boolean type>
  --     |     <datetime type>
  --     |     <interval type>
  [Char] -> [Pattern] -> Production
define [Char]
"PredefinedType" [
    [Char]
"string"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[
      [Char]
"type"[Char] -> Pattern -> Pattern
>: Pattern
"CharacterStringType",
      [Char]
"characters"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
opt([Pattern] -> Pattern
list[Pattern
character_set_, Pattern
"CharacterSetSpecification"]),
      [Char]
"collate"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"CollateClause"],
    [Char]
"nationalString"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list[
      [Char]
"type"[Char] -> Pattern -> Pattern
>: Pattern
"NationalCharacterStringType",
      [Char]
"collate"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"CollateClause"],
    [Char]
"blob"[Char] -> Pattern -> Pattern
>: Pattern
"BinaryLargeObjectStringType",
    [Char]
"numeric"[Char] -> Pattern -> Pattern
>: Pattern
"NumericType",
    [Char]
"boolean"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanType",
    [Char]
"datetime"[Char] -> Pattern -> Pattern
>: Pattern
"DatetimeType",
    [Char]
"interval"[Char] -> Pattern -> Pattern
>: Pattern
"IntervalType"],

  -- <predicate>    ::=
  --         <comparison predicate>
  --     |     <between predicate>
  --     |     <in predicate>
  --     |     <like predicate>
  --     |     <similar predicate>
  --     |     <null predicate>
  --     |     <quantified comparison predicate>
  --     |     <exists predicate>
  --     |     <unique predicate>
  --     |     <normalized predicate>
  --     |     <match predicate>
  --     |     <overlaps predicate>
  --     |     <distinct predicate>
  --     |     <member predicate>
  --     |     <submultiset predicate>
  --     |     <set predicate>
  --     |     <type predicate>
  [Char] -> [Pattern] -> Production
define [Char]
"Predicate" [Pattern]
unsupported,

  -- <query expression>    ::=   [ <with clause> ] <query expression body>
  [Char] -> [Pattern] -> Production
define [Char]
"QueryExpression" [Pattern]
unsupported,

  -- <reference scope check>    ::=   REFERENCES ARE [ NOT ] CHECKED [ ON DELETE <reference scope check action> ]
  [Char] -> [Pattern] -> Production
define [Char]
"ReferenceScopeCheck" [Pattern]
unsupported,

  -- <reference type>    ::=   REF <left paren> <referenced type> <right paren> [ <scope clause> ]
  [Char] -> [Pattern] -> Production
define [Char]
"ReferenceType" [Pattern]
unsupported,

  -- <row type>    ::=   ROW <row type body>
  [Char] -> [Pattern] -> Production
define [Char]
"RowType" [Pattern]
unsupported,

  -- <row value special case>    ::=   <nonparenthesized value expression primary>
  [Char] -> [Pattern] -> Production
define [Char]
"RowValueSpecialCase" [
    Pattern
"NonparenthesizedValueExpressionPrimary"],

  -- <nonparenthesized value expression primary>    ::=
  --         <unsigned value specification>
  --     |     <column reference>
  --     |     <set function specification>
  --     |     <window function>
  --     |     <scalar subquery>
  --     |     <case expression>
  --     |     <cast specification>
  --     |     <field reference>
  --     |     <subtype treatment>
  --     |     <method invocation>
  --     |     <static method invocation>
  --     |     <new specification>
  --     |     <attribute or method reference>
  --     |     <reference resolution>
  --     |     <collection value constructor>
  --     |     <array element reference>
  --     |     <multiset element reference>
  --     |     <routine invocation>
  --     |     <next value expression>
  [Char] -> [Pattern] -> Production
define [Char]
"NonparenthesizedValueExpressionPrimary" [
    [Char]
"unsigned"[Char] -> Pattern -> Pattern
>: Pattern
"UnsignedValueSpecification",
    [Char]
"column"[Char] -> Pattern -> Pattern
>: Pattern
"ColumnReference",
    [Char]
"setFunction"[Char] -> Pattern -> Pattern
>: Pattern
"SetFunctionSpecification",
    [Char]
"windowFunction"[Char] -> Pattern -> Pattern
>: Pattern
"WindowFunction",
    [Char]
"scalarSubquery"[Char] -> Pattern -> Pattern
>: Pattern
"ScalarSubquery",
    [Char]
"cases"[Char] -> Pattern -> Pattern
>: Pattern
"CaseExpression",
    [Char]
"cast"[Char] -> Pattern -> Pattern
>: Pattern
"CastSpecification",
    [Char]
"field"[Char] -> Pattern -> Pattern
>: Pattern
"FieldReference",
    [Char]
"subtype"[Char] -> Pattern -> Pattern
>: Pattern
"SubtypeTreatment",
    [Char]
"method"[Char] -> Pattern -> Pattern
>: Pattern
"MethodInvocation",
    [Char]
"staticMethod"[Char] -> Pattern -> Pattern
>: Pattern
"StaticMethodInvocation",
    [Char]
"new"[Char] -> Pattern -> Pattern
>: Pattern
"NewSpecification",
    [Char]
"attributeOrMethod"[Char] -> Pattern -> Pattern
>: Pattern
"AttributeOrMethodReference",
    [Char]
"reference"[Char] -> Pattern -> Pattern
>: Pattern
"ReferenceResolution",
    [Char]
"collection"[Char] -> Pattern -> Pattern
>: Pattern
"CollectionValueConstructor",
    [Char]
"arrayElement"[Char] -> Pattern -> Pattern
>: Pattern
"ArrayElementReference",
    [Char]
"multisetElement"[Char] -> Pattern -> Pattern
>: Pattern
"MultisetElementReference",
    [Char]
"routine"[Char] -> Pattern -> Pattern
>: Pattern
"RoutineInvocation",
    [Char]
"next"[Char] -> Pattern -> Pattern
>: Pattern
"NextValueExpression"],

  -- <reference resolution>    ::=   DEREF <left paren> <reference value expression> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"ReferenceResolution" [Pattern]
unsupported,

  -- <reference value expression>    ::=   <value expression primary>
  [Char] -> [Pattern] -> Production
define [Char]
"ReferenceValueExpression" [
    Pattern
"ValueExpressionPrimary"],

  -- <row value expression>    ::=
  --         <row value special case>
  --     |     <explicit row value constructor>
  [Char] -> [Pattern] -> Production
define [Char]
"RowValueExpression" [Pattern]
unsupported,

  -- <routine invocation>    ::=   <routine name> <SQL argument list>
  [Char] -> [Pattern] -> Production
define [Char]
"RoutineInvocation" [Pattern]
unsupported,

  -- <scalar subquery>    ::=   <subquery>
  [Char] -> [Pattern] -> Production
define [Char]
"ScalarSubquery" [
    Pattern
"Subquery"],

  -- <scale>    ::=   <unsigned integer>
  [Char] -> [Pattern] -> Production
define [Char]
"Scale" [
    Pattern
"UnsignedInteger"],

  -- <self-referencing column specification>    ::=   REF IS <self-referencing column name> <reference generation>
  [Char] -> [Pattern] -> Production
define [Char]
"SelfReferencingColumnSpecification" [Pattern]
unsupported,

  -- <set function specification>    ::=   <aggregate function> | <grouping operation>
  [Char] -> [Pattern] -> Production
define [Char]
"SetFunctionSpecification" [Pattern]
unsupported,

  -- <static method invocation>    ::=
  --         <path-resolved user-defined type name> <double colon> <method name> [ <SQL argument list> ]
  [Char] -> [Pattern] -> Production
define [Char]
"StaticMethodInvocation" [Pattern]
unsupported,

  -- <string value expression>    ::=   <character value expression> | <blob value expression>
  [Char] -> [Pattern] -> Production
define [Char]
"StringValueExpression" [Pattern]
unsupported,

  -- <subquery>    ::=   <left paren> <query expression> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"Subquery" [
    [Pattern] -> Pattern
parens[Pattern
"QueryExpression"]],

  -- <subtable clause>    ::=   UNDER <supertable clause>
  [Char] -> [Pattern] -> Production
define [Char]
"SubtableClause" [Pattern]
unsupported,

  -- <subtype treatment>    ::=
  --         TREAT <left paren> <subtype operand> AS <target subtype> <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"SubtypeTreatment" [Pattern]
unsupported,

  -- <table commit action>    ::=   PRESERVE | DELETE
  [Char] -> [Pattern] -> Production
define [Char]
"TableCommitAction" [
    [Char]
"preserve"[Char] -> Pattern -> Pattern
>: Pattern
preserve_,
    [Char]
"delete"[Char] -> Pattern -> Pattern
>: Pattern
delete_],

  -- <table constraint definition>    ::=   [ <constraint name definition> ] <table constraint> [ <constraint characteristics> ]
  [Char] -> [Pattern] -> Production
define [Char]
"TableConstraintDefinition" [Pattern]
unsupported,

  -- <table contents source>    ::=
  --         <table element list>
  --     |     OF <path-resolved user-defined type name> [ <subtable clause> ] [ <table element list> ]
  --     |     <as subquery clause>
  [Char] -> [Pattern] -> Production
define [Char]
"TableContentsSource" [
    [Char]
"list"[Char] -> Pattern -> Pattern
>: Pattern
"TableElementList",
    [Char]
"subtable"[Char] -> Pattern -> Pattern
>: [Pattern] -> Pattern
list [
      Pattern
of_,
      [Char]
"type"[Char] -> Pattern -> Pattern
>: Pattern
"PathResolvedUserDefinedTypeName",
      [Char]
"subtable"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"SubtableClause",
      [Char]
"elements"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"TableElementList"],
    [Char]
"subquery"[Char] -> Pattern -> Pattern
>: Pattern
"AsSubqueryClause"],

  -- <table definition>    ::=
  --          CREATE [ <table scope> ] TABLE <table name> <table contents source>
  --          [ ON COMMIT <table commit action> ROWS ]
  [Char] -> [Pattern] -> Production
define [Char]
"TableDefinition" [
    [Pattern] -> Pattern
list[
      Pattern
create_,
      [Char]
"scope"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
optPattern
"TableScope",
      Pattern
table_,
      [Char]
"name"[Char] -> Pattern -> Pattern
>: Pattern
"TableName",
      [Char]
"source"[Char] -> Pattern -> Pattern
>: Pattern
"TableContentsSource",
      [Char]
"commitActions"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
opt([Pattern] -> Pattern
list[Pattern
on_commit_, Pattern
"TableCommitAction", Pattern
rows_])]],

  -- <table element>    ::=
  --         <column definition>
  --     |     <table constraint definition>
  --     |     <like clause>
  --     |     <self-referencing column specification>
  --     |     <column options>
  [Char] -> [Pattern] -> Production
define [Char]
"TableElement" [
    [Char]
"column"[Char] -> Pattern -> Pattern
>: Pattern
"ColumnDefinition",
    [Char]
"tableConstraint"[Char] -> Pattern -> Pattern
>: Pattern
"TableConstraintDefinition",
    [Char]
"like"[Char] -> Pattern -> Pattern
>: Pattern
"LikeClause",
    [Char]
"selfReferencingColumn"[Char] -> Pattern -> Pattern
>: Pattern
"SelfReferencingColumnSpecification",
    [Char]
"columOptions"[Char] -> Pattern -> Pattern
>: Pattern
"ColumnOptions"],

  -- <table element list>    ::=   <left paren> <table element> [ { <comma> <table element> }... ] <right paren>
  [Char] -> [Pattern] -> Production
define [Char]
"TableElementList" [
    [Pattern] -> Pattern
parens[Pattern -> Pattern
commaList Pattern
"TableElement"]],

  -- <table scope>    ::=   <global or local> TEMPORARY
  [Char] -> [Pattern] -> Production
define [Char]
"TableScope" [
    [Pattern] -> Pattern
list[Pattern
"GlobalOrLocal", Pattern
temporary_]],

  -- <time literal>    ::=   TIME <time string>
  [Char] -> [Pattern] -> Production
define [Char]
"TimeLiteral" [
    [Pattern] -> Pattern
list[Pattern
time_, Pattern
"TimeString"]],

  [Char] -> [Pattern] -> Production
define [Char]
"TruthValue" [
    Pattern
true_,
    Pattern
false_,
    Pattern
unknown_],

  -- <unsigned literal>    ::=   <unsigned numeric literal> | <general literal>
  [Char] -> [Pattern] -> Production
define [Char]
"UnsignedLiteral" [
    [Char]
"numeric"[Char] -> Pattern -> Pattern
>: Pattern
"UnsignedNumericLiteral",
    [Char]
"general"[Char] -> Pattern -> Pattern
>: Pattern
"GeneralLiteral"],

  -- <unsigned numeric literal>    ::=   <exact numeric literal> | <approximate numeric literal>
  [Char] -> [Pattern] -> Production
define [Char]
"UnsignedNumericLiteral" [
    [Char]
"exact"[Char] -> Pattern -> Pattern
>: Pattern
"ExactNumericLiteral",
    [Char]
"approximate"[Char] -> Pattern -> Pattern
>: Pattern
"ApproximateNumericLiteral"],

  -- <unsigned value specification>    ::=   <unsigned literal> | <general value specification>
  [Char] -> [Pattern] -> Production
define [Char]
"UnsignedValueSpecification" [
    [Char]
"literal"[Char] -> Pattern -> Pattern
>: Pattern
"UnsignedLiteral",
    [Char]
"general"[Char] -> Pattern -> Pattern
>: Pattern
"GeneralValueSpecification"],

  -- <user-defined type value expression>    ::=   <value expression primary>
  [Char] -> [Pattern] -> Production
define [Char]
"UserDefinedTypeValueExpression" [
    Pattern
"ValueExpressionPrimary"],

  -- <value expression>    ::=
  --         <common value expression>
  --     |     <boolean value expression>
  --     |     <row value expression>
  [Char] -> [Pattern] -> Production
define [Char]
"ValueExpression" [
    [Char]
"common"[Char] -> Pattern -> Pattern
>: Pattern
"CommonValueExpression",
    [Char]
"boolean"[Char] -> Pattern -> Pattern
>: Pattern
"BooleanValueExpression",
    [Char]
"row"[Char] -> Pattern -> Pattern
>: Pattern
"RowValueExpression"],

  -- <value expression primary>    ::=
  --         <parenthesized value expression>
  --     |     <nonparenthesized value expression primary>
  [Char] -> [Pattern] -> Production
define [Char]
"ValueExpressionPrimary" [
    [Char]
"parens"[Char] -> Pattern -> Pattern
>: Pattern
"ParenthesizedValueExpression",
    [Char]
"noparens"[Char] -> Pattern -> Pattern
>: Pattern
"NonparenthesizedValueExpressionPrimary"],

  -- <window function>    ::=   <window function type> OVER <window name or specification>
  [Char] -> [Pattern] -> Production
define [Char]
"WindowFunction" [Pattern]
unsupported]

and_ :: Pattern
and_ = [Char] -> Pattern
terminal [Char]
"AND"
array_ :: Pattern
array_ = [Char] -> Pattern
terminal [Char]
"ARRAY"
bigint_ :: Pattern
bigint_ = [Char] -> Pattern
terminal [Char]
"BIGINT"
binary_large_object_ :: Pattern
binary_large_object_ = [Char] -> Pattern
terminal [Char]
"BINARY LARGE OBJECT"
blob_ :: Pattern
blob_ = [Char] -> Pattern
terminal [Char]
"BLOB"
boolean_ :: Pattern
boolean_ = [Char] -> Pattern
terminal [Char]
"BOOLEAN"
char_ :: Pattern
char_ = [Char] -> Pattern
terminal [Char]
"CHAR"
char_large_object_ :: Pattern
char_large_object_ = [Char] -> Pattern
terminal [Char]
"CHAR LARGE OBJECT"
char_varying_ :: Pattern
char_varying_ = [Char] -> Pattern
terminal [Char]
"CHAR VARYING"
character_ :: Pattern
character_ = [Char] -> Pattern
terminal [Char]
"CHARACTER"
character_large_object_ :: Pattern
character_large_object_ = [Char] -> Pattern
terminal [Char]
"CHARACTER LARGE OBJECT"
character_set_ :: Pattern
character_set_ = [Char] -> Pattern
terminal [Char]
"CHARACTER SET"
character_varying_ :: Pattern
character_varying_ = [Char] -> Pattern
terminal [Char]
"CHARACTER VARYING"
clob_ :: Pattern
clob_ = [Char] -> Pattern
terminal [Char]
"CLOB"
comma_ :: Pattern
comma_ = [Char] -> Pattern
terminal [Char]
","
create_ :: Pattern
create_ = [Char] -> Pattern
terminal [Char]
"CREATE"
date_ :: Pattern
date_ = [Char] -> Pattern
terminal [Char]
"DATE"
dec_ :: Pattern
dec_ = [Char] -> Pattern
terminal [Char]
"DEC"
decimal_ :: Pattern
decimal_ = [Char] -> Pattern
terminal [Char]
"DECIMAL"
default_values_ :: Pattern
default_values_ = [Char] -> Pattern
terminal [Char]
"DEFAULT VALUES"
delete_ :: Pattern
delete_ = [Char] -> Pattern
terminal [Char]
"DELETE"
double_precision_ :: Pattern
double_precision_ = [Char] -> Pattern
terminal [Char]
"DOUBLE PRECISION"
false_ :: Pattern
false_ = [Char] -> Pattern
terminal [Char]
"FALSE"
float_ :: Pattern
float_ = [Char] -> Pattern
terminal [Char]
"FLOAT"
global_ :: Pattern
global_ = [Char] -> Pattern
terminal [Char]
"GLOBAL"
insert_into_ :: Pattern
insert_into_ = [Char] -> Pattern
terminal [Char]
"INSERT INTO"
int_ :: Pattern
int_ = [Char] -> Pattern
terminal [Char]
"INT"
integer_ :: Pattern
integer_ = [Char] -> Pattern
terminal [Char]
"INTEGER"
is_ :: Pattern
is_ = [Char] -> Pattern
terminal [Char]
"IS"
left_paren_ :: Pattern
left_paren_ = [Char] -> Pattern
terminal [Char]
"("
local_ :: Pattern
local_ = [Char] -> Pattern
terminal [Char]
"LOCAL"
multiset_ :: Pattern
multiset_ = [Char] -> Pattern
terminal [Char]
"MULTISET"
numeric_ :: Pattern
numeric_ = [Char] -> Pattern
terminal [Char]
"NUMERIC"
of_ :: Pattern
of_ = [Char] -> Pattern
terminal [Char]
"OF"
not_ :: Pattern
not_ = [Char] -> Pattern
terminal [Char]
"NOT"
on_commit_ :: Pattern
on_commit_ = [Char] -> Pattern
terminal [Char]
"ON COMMIT"
or_ :: Pattern
or_ = [Char] -> Pattern
terminal [Char]
"OR"
overriding_user_value_ :: Pattern
overriding_user_value_ = [Char] -> Pattern
terminal [Char]
"OVERRIDING USER VALUE"
overriding_system_value :: Pattern
overriding_system_value = [Char] -> Pattern
terminal [Char]
"OVERRIDING SYSTEM VALUE"
preserve_ :: Pattern
preserve_ = [Char] -> Pattern
terminal [Char]
"PRESERVE"
real_ :: Pattern
real_ = [Char] -> Pattern
terminal [Char]
"REAL"
right_paren_ :: Pattern
right_paren_ = [Char] -> Pattern
terminal [Char]
")"
rows_ :: Pattern
rows_ = [Char] -> Pattern
terminal [Char]
"ROWS"
smallint_ :: Pattern
smallint_ = [Char] -> Pattern
terminal [Char]
"SMALLINT"
table_ :: Pattern
table_ = [Char] -> Pattern
terminal [Char]
"TABLE"
temporary_ :: Pattern
temporary_ = [Char] -> Pattern
terminal [Char]
"TEMPORARY"
time_ :: Pattern
time_ = [Char] -> Pattern
terminal [Char]
"TIME"
true_ :: Pattern
true_ = [Char] -> Pattern
terminal [Char]
"TRUE"
unknown_ :: Pattern
unknown_ = [Char] -> Pattern
terminal [Char]
"UNKNOWN"
values_ :: Pattern
values_ = [Char] -> Pattern
terminal [Char]
"VALUES"
varchar_ :: Pattern
varchar_ = [Char] -> Pattern
terminal [Char]
"VARCHAR"

commaList :: Pattern -> Pattern
commaList Pattern
pat = [Pattern] -> Pattern
list[
  [Char]
"first"[Char] -> Pattern -> Pattern
>: Pattern
pat,
  [Char]
"rest"[Char] -> Pattern -> Pattern
>: Pattern -> Pattern
star([Pattern] -> Pattern
list[Pattern
comma_, Pattern
pat])]
parens :: [Pattern] -> Pattern
parens [Pattern]
ps = [Pattern] -> Pattern
list ([Pattern] -> Pattern) -> [Pattern] -> Pattern
forall a b. (a -> b) -> a -> b
$ [Pattern
left_paren_] [Pattern] -> [Pattern] -> [Pattern]
forall a. [a] -> [a] -> [a]
++ [Pattern]
ps [Pattern] -> [Pattern] -> [Pattern]
forall a. [a] -> [a] -> [a]
++ [Pattern
right_paren_]
unsupported :: [Pattern]
unsupported = [[Char] -> Pattern
terminal [Char]
"unsupported"]