-- ---------------------------------------------------------------------------
{
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
parseHeader ) where
import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..), defaultInlineSpec )
+import DynFlags
import OrdList
import HaddockParse
import {-# SOURCE #-} HaddockLex hiding ( Token )
{-
-----------------------------------------------------------------------------
+24 Februar 2006
+
+Conflicts: 33 shift/reduce
+ 1 reduce/reduce
+
+The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
+would think the two should never occur in the same context.
+
+ -=chak
+
+-----------------------------------------------------------------------------
31 December 2006
Conflicts: 34 shift/reduce
'data' { L _ ITdata }
'default' { L _ ITdefault }
'deriving' { L _ ITderiving }
- 'derive' { L _ ITderive }
'do' { L _ ITdo }
'else' { L _ ITelse }
'hiding' { L _ IThiding }
| qcon { $1 }
| qvarop { $1 }
| qconop { $1 }
+ | '(' '->' ')' { LL $ getRdrName funTyCon }
-----------------------------------------------------------------------------
-- Module Header
{% fileSrcSpan >>= \ loc -> case $1 of { (opt, info, doc) ->
return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
opt info doc) )}}
- | missing_module_keyword top close
+ | body2
{% fileSrcSpan >>= \ loc ->
return (L loc (HsModule Nothing Nothing
- (fst $2) (snd $2) Nothing Nothing emptyHaddockModInfo
+ (fst $1) (snd $1) Nothing Nothing emptyHaddockModInfo
Nothing)) }
optdoc :: { (Maybe String, HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
: '{' top '}' { $2 }
| vocurly top close { $2 }
+body2 :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
+ : '{' top '}' { $2 }
+ | missing_module_keyword top close { $2 }
+
top :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
: importdecls { (reverse $1,[]) }
| importdecls ';' cvtopdecls { (reverse $1,$3) }
(unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
-- data/newtype family
- | data_or_newtype 'family' tycl_hdr opt_kind_sig
+ | 'data' 'family' tycl_hdr opt_kind_sig
{% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
; checkTyVars tparms -- no type pattern
; unless (null (unLoc ctxt)) $ -- and no context
"A family declaration cannot have a context"
; return $
L (comb3 $1 $2 $4)
- (TyFamily (DataFamily (unLoc $1)) tc tvs
- (unLoc $4)) } }
+ (TyFamily DataFamily tc tvs (unLoc $4)) } }
-- data/newtype instance declaration
| data_or_newtype 'instance' tycl_hdr constrs deriving
} }
-- data/newtype family declaration
- | data_or_newtype tycl_hdr opt_kind_sig
+ | 'data' tycl_hdr opt_kind_sig
{% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
; checkTyVars tparms -- no type pattern
; unless (null (unLoc ctxt)) $ -- and no context
"A family declaration cannot have a context"
; return $
L (comb3 $1 $2 $3)
- (TyFamily (DataFamily (unLoc $1)) tc tvs
- (unLoc $3))
+ (TyFamily DataFamily tc tvs (unLoc $3))
} }
-- Associate type instances
-- Glasgow extension: stand-alone deriving declarations
stand_alone_deriving :: { LDerivDecl RdrName }
- : 'derive' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
+ : 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
-----------------------------------------------------------------------------
-- Nested declarations
: 'forall' tv_bndrs '.' { LL $2 }
| {- empty -} { noLoc [] }
-constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
+constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
-- We parse the constructor declaration
-- C t1 t2
-- as a btype (treating C as a type constructor) and then convert C to be
| oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
| btype conop btype { LL ($2, InfixCon $1 $3) }
-constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
+constr_stuff_record :: { Located (Located RdrName, HsConDeclDetails RdrName) }
: oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
| oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
| 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
| 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
| 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
- | '-' fexp { LL $ mkHsNegApp $2 }
+ | '-' fexp { LL $ NegApp $2 noSyntaxExpr }
| 'do' stmtlist {% let loc = comb2 $1 $2 in
checkDo loc (unLoc $2) >>= \ (stmts,body) ->
| fexp { $1 }
scc_annot :: { Located FastString }
- : '_scc_' STRING { LL $ getSTRING $2 }
+ : '_scc_' STRING {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
+ (return $ LL $ getSTRING $2) }
| '{-# SCC' STRING '#-}' { LL $ getSTRING $2 }
hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
| aexp1 { $1 }
aexp1 :: { LHsExpr RdrName }
- : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
- (reverse $3);
- return (LL r) }}
+ : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3
+ ; return (LL r) }}
| aexp2 { $1 }
-- Here was the syntax for type applications that I was planning
| '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
| '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
| '[p|' infixexp '|]' {% checkPattern $2 >>= \p ->
- return (LL $ HsBracket (PatBr p)) }
- | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBr (mkGroup $2)) }
+ return (LL $ HsBracket (PatBr p)) }
+ | '[d|' cvtopbody '|]' {% checkDecBrGroup $2 >>= \g ->
+ return (LL $ HsBracket (DecBr g)) }
-- arrow notation extension
| '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) }
parr :: { LHsExpr RdrName }
: { noLoc (ExplicitPArr placeHolderType []) }
- | exp { L1 $ ExplicitPArr placeHolderType [$1] }
+ | texp { L1 $ ExplicitPArr placeHolderType [$1] }
| lexps { L1 $ ExplicitPArr placeHolderType
(reverse (unLoc $1)) }
- | exp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
- | exp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
- | exp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
+ | texp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
+ | texp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
+ | texp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
-- We are reusing `lexps' and `pquals' from the list case.
-- Bangs inside are parsed as infix operator applications, so that
-- we parse them right when bang-patterns are off
pat :: { LPat RdrName }
-pat : infixexp {% checkPattern $1 }
+pat : exp {% checkPattern $1 }
| '!' aexp {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
apat :: { LPat RdrName }
stmt :: { LStmt RdrName }
: qual { $1 }
--- What is this next production doing? I have no clue! SLPJ Dec06
- | infixexp '->' exp {% checkPattern $3 >>= \p ->
- return (LL $ mkBindStmt p $1) }
| 'rec' stmtlist { LL $ mkRecStmt (unLoc $2) }
qual :: { LStmt RdrName }
-----------------------------------------------------------------------------
-- Record Field Update/Construction
-fbinds :: { HsRecordBinds RdrName }
+fbinds :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
: fbinds1 { $1 }
- | {- empty -} { [] }
+ | {- empty -} { ([], False) }
-fbinds1 :: { HsRecordBinds RdrName }
- : fbinds1 ',' fbind { $3 : $1 }
- | fbind { [$1] }
+fbinds1 :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
+ : fbind ',' fbinds1 { case $3 of (flds, dd) -> ($1 : flds, dd) }
+ | fbind { ([$1], False) }
+ | '..' { ([], True) }
-fbind :: { (Located RdrName, LHsExpr RdrName) }
- : qvar '=' exp { ($1,$3) }
+fbind :: { HsRecField RdrName (LHsExpr RdrName) }
+ : qvar '=' exp { HsRecField $1 $3 False }
+ | qvar { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) 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
-----------------------------------------------------------------------------
-- Implicit Parameter Bindings
: 'as' { L1 FSLIT("as") }
| 'qualified' { L1 FSLIT("qualified") }
| 'hiding' { L1 FSLIT("hiding") }
- | 'derive' { L1 FSLIT("derive") }
| 'export' { L1 FSLIT("export") }
| 'label' { L1 FSLIT("label") }
| 'dynamic' { L1 FSLIT("dynamic") }
projects / ghc-hetmet.git / blobdiff