'stdcall' { L _ ITstdcallconv }
'ccall' { L _ ITccallconv }
'prim' { L _ ITprimcallconv }
- 'dotnet' { L _ ITdotnet }
'proc' { L _ ITproc } -- for arrow notation extension
'rec' { L _ ITrec } -- for arrow notation extension
'group' { L _ ITgroup } -- for list transform extension
: {- empty -} {% pushCurrentContext }
maybemodwarning :: { Maybe WarningTxt }
- : '{-# DEPRECATED' STRING '#-}' { Just (DeprecatedTxt (getSTRING $2)) }
- | '{-# WARNING' STRING '#-}' { Just (WarningTxt (getSTRING $2)) }
+ : '{-# DEPRECATED' strings '#-}' { Just (DeprecatedTxt $ unLoc $2) }
+ | '{-# WARNING' strings '#-}' { Just (WarningTxt $ unLoc $2) }
| {- empty -} { Nothing }
body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
-- Glasgow extension: stand-alone deriving declarations
stand_alone_deriving :: { LDerivDecl RdrName }
- : 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
+ : 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
-----------------------------------------------------------------------------
-- Nested declarations
-- SUP: TEMPORARY HACK, not checking for `module Foo'
warning :: { OrdList (LHsDecl RdrName) }
- : namelist STRING
- { toOL [ LL $ WarningD (Warning n (WarningTxt (getSTRING $2)))
+ : namelist strings
+ { toOL [ LL $ WarningD (Warning n (WarningTxt $ unLoc $2))
| n <- unLoc $1 ] }
deprecations :: { OrdList (LHsDecl RdrName) }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
deprecation :: { OrdList (LHsDecl RdrName) }
- : namelist STRING
- { toOL [ LL $ WarningD (Warning n (DeprecatedTxt (getSTRING $2)))
+ : namelist strings
+ { toOL [ LL $ WarningD (Warning n (DeprecatedTxt $ unLoc $2))
| n <- unLoc $1 ] }
+strings :: { Located [FastString] }
+ : STRING { L1 [getSTRING $1] }
+ | '[' stringlist ']' { LL $ fromOL (unLoc $2) }
+
+stringlist :: { Located (OrdList FastString) }
+ : stringlist ',' STRING { LL (unLoc $1 `snocOL` getSTRING $3) }
+ | STRING { LL (unitOL (getSTRING $1)) }
+
-----------------------------------------------------------------------------
-- Annotations
annotation :: { LHsDecl RdrName }
| 'export' callconv fspec
{% mkExport $2 (unLoc $3) >>= return.LL }
-callconv :: { CallConv }
- : 'stdcall' { CCall StdCallConv }
- | 'ccall' { CCall CCallConv }
- | 'prim' { CCall PrimCallConv}
- | 'dotnet' { DNCall }
+callconv :: { CCallConv }
+ : 'stdcall' { StdCallConv }
+ | 'ccall' { CCallConv }
+ | 'prim' { PrimCallConv}
safety :: { Safety }
: 'unsafe' { PlayRisky }
-- | STRING { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) }
| INTEGER { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) }
| RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
+
-- N.B.: sections get parsed by these next two productions.
-- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
-- (you'd have to write '((+ 3), (4 -))')
-- but the less cluttered version fell out of having texps.
| '(' texp ')' { LL (HsPar $2) }
- | '(' texp ',' texps ')' { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
- | '(#' texps '#)' { LL $ ExplicitTuple (reverse $2) Unboxed }
+ | '(' tup_exprs ')' { LL (ExplicitTuple $2 Boxed) }
+
+ | '(#' texp '#)' { LL (ExplicitTuple [Present $2] Unboxed) }
+ | '(#' tup_exprs '#)' { LL (ExplicitTuple $2 Unboxed) }
+
| '[' list ']' { LL (unLoc $2) }
| '[:' parr ':]' { LL (unLoc $2) }
| '_' { L1 EWildPat }
: {- empty -} { [] }
| cvtopdecls { $1 }
+-----------------------------------------------------------------------------
+-- Tuple expressions
+
-- "texp" is short for tuple expressions:
-- things that can appear unparenthesized as long as they're
-- inside parens or delimitted by commas
-- View patterns get parenthesized above
| exp '->' exp { LL $ EViewPat $1 $3 }
-texps :: { [LHsExpr RdrName] }
- : texps ',' texp { $3 : $1 }
- | texp { [$1] }
+-- Always at least one comma
+tup_exprs :: { [HsTupArg RdrName] }
+ : texp commas_tup_tail { Present $1 : $2 }
+ | commas tup_tail { replicate $1 missingTupArg ++ $2 }
+
+-- Always starts with commas; always follows an expr
+commas_tup_tail :: { [HsTupArg RdrName] }
+commas_tup_tail : commas tup_tail { replicate ($1-1) missingTupArg ++ $2 }
+-- Always follows a comma
+tup_tail :: { [HsTupArg RdrName] }
+ : texp commas_tup_tail { Present $1 : $2 }
+ | texp { [Present $1] }
+ | {- empty -} { [missingTupArg] }
-----------------------------------------------------------------------------
-- List expressions
transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
: 'then' exp { LL $ \leftStmts -> (mkTransformStmt (reverse leftStmts) $2) }
+ -- >>>
| 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt (reverse leftStmts) $2 $4) }
| 'then' 'group' 'by' exp { LL $ \leftStmts -> (mkGroupByStmt (reverse leftStmts) $4) }
+ -- <<<
+ -- These two productions deliberately have a shift-reduce conflict. I have made 'group' into a special_id,
+ -- which means you can enable TransformListComp while still using Data.List.group. However, this makes the two
+ -- productions ambiguous. I've set things up so that Happy chooses to resolve the conflict in that case by
+ -- choosing the "group by" variant, which is what we want.
+ --
+ -- This is rather dubious: the user might be confused as to how to parse this statement. However, it is a good
+ -- practical choice. NB: Data.List.group :: [a] -> [[a]], so using the first production would not even type check
+ -- if /that/ is the group function we conflict with.
| 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt (reverse leftStmts) $4) }
| 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt (reverse leftStmts) $4 $6) }
fbind :: { HsRecField RdrName (LHsExpr RdrName) }
: qvar '=' exp { HsRecField $1 $3 False }
- | qvar { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) True }
+ | qvar { HsRecField $1 (L (getLoc $1) placeHolderPunRhs) True }
-- Here's where we say that plain 'x'
-- means exactly 'x = x'. The pun-flag boolean is
-- there so we can still print it right
sysdcon :: { Located DataCon } -- Wired in data constructors
: '(' ')' { LL unitDataCon }
- | '(' commas ')' { LL $ tupleCon Boxed $2 }
+ | '(' commas ')' { LL $ tupleCon Boxed ($2 + 1) }
| '(#' '#)' { LL $ unboxedSingletonDataCon }
- | '(#' commas '#)' { LL $ tupleCon Unboxed $2 }
+ | '(#' commas '#)' { LL $ tupleCon Unboxed ($2 + 1) }
| '[' ']' { LL nilDataCon }
conop :: { Located RdrName }
gtycon :: { Located RdrName } -- A "general" qualified tycon
: oqtycon { $1 }
| '(' ')' { LL $ getRdrName unitTyCon }
- | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed $2) }
+ | '(' commas ')' { LL $ getRdrName (tupleTyCon Boxed ($2 + 1)) }
| '(#' '#)' { LL $ getRdrName unboxedSingletonTyCon }
- | '(#' commas '#)' { LL $ getRdrName (tupleTyCon Unboxed $2) }
+ | '(#' commas '#)' { LL $ getRdrName (tupleTyCon Unboxed ($2 + 1)) }
| '(' '->' ')' { LL $ getRdrName funTyCon }
| '[' ']' { LL $ listTyCon_RDR }
| '[:' ':]' { LL $ parrTyCon_RDR }
| 'stdcall' { L1 (fsLit "stdcall") }
| 'ccall' { L1 (fsLit "ccall") }
| 'prim' { L1 (fsLit "prim") }
+ | 'group' { L1 (fsLit "group") }
special_sym :: { Located FastString }
special_sym : '!' { L1 (fsLit "!") }
commas :: { Int }
: commas ',' { $1 + 1 }
- | ',' { 2 }
+ | ',' { 1 }
-----------------------------------------------------------------------------
-- Documentation comments
projects / ghc-hetmet.git / blobdiff