[project @ 2001-04-05 11:54:37 by simonpj]

[ghc-hetmet.git] / ghc / compiler / parser / ParseUtil.lhs

diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index 5f929c6..969ca93 100644 (file)
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -31,13 +31,13 @@ module ParseUtil (
 import Lex
 import HsSyn           -- Lots of it
 import SrcLoc
-import RdrHsSyn                ( mkNPlusKPatIn, unitTyCon_RDR,
-                         RdrBinding(..),
+import RdrHsSyn                ( RdrBinding(..),
                          RdrNameHsType, RdrNameBangType, RdrNameContext,
                          RdrNameHsTyVar, RdrNamePat, RdrNameHsExpr, RdrNameGRHSs,
                          RdrNameHsRecordBinds, RdrNameMonoBinds, RdrNameConDetails
                        )
 import RdrName
+import PrelNames       ( unitTyCon_RDR )
 import CallConv
 import OccName         ( dataName, varName, tcClsName,
                          occNameSpace, setOccNameSpace, occNameUserString )
@@ -130,16 +130,16 @@ checkContext t
 checkPred :: RdrNameHsType -> [RdrNameHsType] 
        -> P (HsPred RdrName)
 checkPred (HsTyVar t) args@(_:_) | not (isRdrTyVar t) 
-       = returnP (HsPClass t args)
+       = returnP (HsClassP t args)
 checkPred (HsAppTy l r) args = checkPred l (r:args)
-checkPred (HsPredTy (HsPIParam n ty)) [] = returnP (HsPIParam n ty)
+checkPred (HsPredTy (HsIParam n ty)) [] = returnP (HsIParam n ty)
 checkPred _ _ = parseError "Illegal class assertion"
 
 checkDictTy :: RdrNameHsType -> [RdrNameHsType] -> P RdrNameHsType
 checkDictTy (HsTyVar t) args@(_:_) | not (isRdrTyVar t) 
        = returnP (mkHsDictTy t args)
 checkDictTy (HsAppTy l r) args = checkDictTy l (r:args)
-checkDictTy _ _ = parseError "Illegal class assertion"
+checkDictTy _ _ = parseError "Malformed context in instance header"
 
 -- Put more comments!
 -- Checks that the lhs of a datatype declaration
@@ -200,9 +200,11 @@ checkPat e [] = case e of
                              in
                              returnP (SigPatIn e t')
 
-       OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral k _)) 
+       OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral k)) 
                           | plus == plus_RDR
-                          -> returnP (mkNPlusKPatIn n lit)
+                          -> returnP (NPlusKPatIn n lit)
+                          where
+                             plus_RDR = mkUnqual varName SLIT("+")     -- Hack
 
        OpApp l op fix r   -> checkPat l [] `thenP` \l ->
                              checkPat r [] `thenP` \r ->
@@ -334,6 +336,4 @@ groupBindings binds = group Nothing binds
            = case bind of
                RdrValBinding b@(FunMonoBind _ _ _ _) -> group (Just b) binds
                other -> bind `RdrAndBindings` group Nothing binds
-
-plus_RDR = mkSrcUnqual varName SLIT("+")
 \end{code}