From: simonmar <unknown>
Date: Thu, 3 Aug 2000 13:22:47 +0000 (+0000)
Subject: [project @ 2000-08-03 13:22:47 by simonmar]
X-Git-Tag: Approximately_9120_patches~3922
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8b102da80df1406adcbc62517f72d5ebd5112786;p=ghc-hetmet.git

[project @ 2000-08-03 13:22:47 by simonmar]
The parser didn't properly check that the constructor in a data
declaration really are constructors (ie. begin with an upper case
character).  This patch fixes the problem.

bug reported by: Tim Giesler, a couple of weeks ago.
---

diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index c491803..dffa2b7 100644
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -54,9 +54,9 @@ import RdrHsSyn
 import RdrName
 import CallConv
 import PrelNames 	( pRELUDE_Name, mkTupNameStr )
-import OccName  	( dataName, tcName, varName, tvName, setOccNameSpace, occNameUserString )
+import OccName  	( dataName, tcName, varName, tvName, tcClsName,
+			  occNameSpace, setOccNameSpace, occNameUserString )
 import CmdLineOpts 	( opt_NoImplicitPrelude )
-import StringBuffer 	( lexemeToString )
 import FastString	( unpackFS )
 import BasicTypes	( Boxity(..) )
 import UniqFM		( UniqFM, listToUFM, lookupUFM )
@@ -87,7 +87,13 @@ splitForConApp  t ts = split t ts
  where
 	split (HsAppTy t u) ts = split t (Unbanged u : ts)
 
-	split (HsTyVar t)   ts  = returnP (con, ts)
+	split (HsTyVar t)   ts  = 
+		-- check that we've got a type constructor at the head
+	   if occNameSpace t_occ /= tcClsName
+		then parseError 
+			(showSDoc (text "not a constructor: `" <> 
+					ppr t <> char '\''))
+		else returnP (con, ts)
 	   where t_occ = rdrNameOcc t
 		 con   = setRdrNameOcc t (setOccNameSpace t_occ dataName)