Give slightly more accurate line numbers for certain pattern parse errors.
, checkDataHeader -- HsQualType -> P (HsContext,HsName,[HsName])
, checkSimple -- HsType -> [HsName] -> P ((HsName,[HsName]))
, checkPattern -- HsExp -> P HsPat
, checkDataHeader -- HsQualType -> P (HsContext,HsName,[HsName])
, checkSimple -- HsType -> [HsName] -> P ((HsName,[HsName]))
, checkPattern -- HsExp -> P HsPat
- , checkPatterns -- [HsExp] -> P [HsPat]
+ , checkPatterns -- SrcLoc -> [HsExp] -> P [HsPat]
-- , checkExpr -- HsExp -> P HsExp
, checkValDef -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
, checkValSig -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
-- , checkExpr -- HsExp -> P HsExp
, checkValDef -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
, checkValSig -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
-- We parse patterns as expressions and check for valid patterns below,
-- converting the expression into a pattern at the same time.
-- We parse patterns as expressions and check for valid patterns below,
-- converting the expression into a pattern at the same time.
-checkPattern :: RdrNameHsExpr -> P RdrNamePat
-checkPattern e = checkPat e []
+checkPattern :: SrcLoc -> RdrNameHsExpr -> P RdrNamePat
+checkPattern loc e = setSrcLocP loc (checkPat e [])
-checkPatterns :: [RdrNameHsExpr] -> P [RdrNamePat]
-checkPatterns es = mapP checkPattern es
+checkPatterns :: SrcLoc -> [RdrNameHsExpr] -> P [RdrNamePat]
+checkPatterns loc es = mapP (checkPattern loc) es
checkPat :: RdrNameHsExpr -> [RdrNamePat] -> P RdrNamePat
checkPat (HsVar c) args | isRdrDataCon c = returnP (ConPatIn c args)
checkPat :: RdrNameHsExpr -> [RdrNamePat] -> P RdrNamePat
checkPat (HsVar c) args | isRdrDataCon c = returnP (ConPatIn c args)
checkValDef lhs opt_sig grhss loc
= case isFunLhs lhs [] of
Just (f,inf,es) ->
checkValDef lhs opt_sig grhss loc
= case isFunLhs lhs [] of
Just (f,inf,es) ->
- checkPatterns es `thenP` \ps ->
+ checkPatterns loc es `thenP` \ps ->
returnP (RdrValBinding (FunMonoBind f inf [Match [] ps opt_sig grhss] loc))
Nothing ->
returnP (RdrValBinding (FunMonoBind f inf [Match [] ps opt_sig grhss] loc))
Nothing ->
- checkPattern lhs `thenP` \lhs ->
+ checkPattern loc lhs `thenP` \lhs ->
returnP (RdrValBinding (PatMonoBind lhs grhss loc))
checkValSig
returnP (RdrValBinding (PatMonoBind lhs grhss loc))
checkValSig
{-
-----------------------------------------------------------------------------
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.59 2001/05/03 08:08:44 simonpj Exp $
+$Id: Parser.y,v 1.60 2001/05/07 14:38:15 simonmar Exp $
(panic "fixity") $3 )}
exp10 :: { RdrNameHsExpr }
(panic "fixity") $3 )}
exp10 :: { RdrNameHsExpr }
- : '\\' aexp aexps opt_asig '->' srcloc exp
- {% checkPatterns ($2 : reverse $3) `thenP` \ ps ->
- returnP (HsLam (Match [] ps $4
- (GRHSs (unguardedRHS $7 $6)
+ : '\\' srcloc aexp aexps opt_asig '->' srcloc exp
+ {% checkPatterns $2 ($3 : reverse $4) `thenP` \ ps ->
+ returnP (HsLam (Match [] ps $5
+ (GRHSs (unguardedRHS $8 $7)
EmptyBinds Nothing))) }
| 'let' declbinds 'in' exp { HsLet $2 $4 }
| 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 }
EmptyBinds Nothing))) }
| 'let' declbinds 'in' exp { HsLet $2 $4 }
| 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 }
| alt { [$1] }
alt :: { RdrNameMatch }
| alt { [$1] }
alt :: { RdrNameMatch }
- : infixexp opt_sig ralt wherebinds
- {% (checkPattern $1 `thenP` \p ->
- returnP (Match [] [p] $2
- (GRHSs $3 $4 Nothing)) )}
+ : srcloc infixexp opt_sig ralt wherebinds
+ {% (checkPattern $1 $2 `thenP` \p ->
+ returnP (Match [] [p] $3
+ (GRHSs $4 $5 Nothing)) )}
ralt :: { [RdrNameGRHS] }
: '->' srcloc exp { [GRHS [ExprStmt $3 $2] $2] }
ralt :: { [RdrNameGRHS] }
: '->' srcloc exp { [GRHS [ExprStmt $3 $2] $2] }
| {- nothing -} { Nothing }
stmt :: { RdrNameStmt }
| {- nothing -} { Nothing }
stmt :: { RdrNameStmt }
- : srcloc infixexp '<-' exp {% checkPattern $2 `thenP` \p ->
+ : srcloc infixexp '<-' exp {% checkPattern $1 $2 `thenP` \p ->
returnP (BindStmt p $4 $1) }
| srcloc exp { ExprStmt $2 $1 }
| srcloc 'let' declbinds { LetStmt $3 }
returnP (BindStmt p $4 $1) }
| srcloc exp { ExprStmt $2 $1 }
| srcloc 'let' declbinds { LetStmt $3 }