[project @ 2001-05-07 14:38:15 by simonmar]

Give slightly more accurate line numbers for certain pattern parse errors.

2 files changed, 17 insertions, 17 deletions

diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index c4fa82a059..229b15fae7 100644
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -20,7 +20,7 @@ module ParseUtil (
 	, 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
@@ -172,11 +172,11 @@ checkSimple t _ = parseError "Illegal left hand side in data/newtype declaration
 -- 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)
@@ -249,11 +249,11 @@ checkValDef
 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 ->
-		checkPattern lhs `thenP` \lhs ->
+		checkPattern loc lhs `thenP` \lhs ->
 		returnP (RdrValBinding (PatMonoBind lhs grhss loc))
 
 checkValSig
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 61a3275c64..8894a00024 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$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 $
 
 Haskell grammar.
 
@@ -688,10 +688,10 @@ infixexp :: { 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 }
@@ -814,10 +814,10 @@ alts1 	:: { [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] }
@@ -857,7 +857,7 @@ maybe_stmt :: { Maybe 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 }