trim Data.Sequence import, in preparation for expanding its API

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

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 5d54c2f..e8d00a2 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -19,6 +19,7 @@ module RdrHsSyn (
         cvBindsAndSigs,
        cvTopDecls,
        findSplice, checkDecBrGroup,
+        placeHolderPunRhs,
 
        -- Stuff to do with Foreign declarations
        mkImport,
@@ -53,8 +54,7 @@ import HsSyn          -- Lots of it
 import Class            ( FunDep )
 import TypeRep          ( Kind )
 import RdrName         ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, 
-                         isRdrDataCon, isUnqual, getRdrName, isQual,
-                         setRdrNameSpace, showRdrName )
+                         isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace )
 import BasicTypes      ( maxPrecedence, Activation, RuleMatchInfo,
                           InlinePragma(..),  InlineSpec(..),
                           alwaysInlineSpec, neverInlineSpec )
@@ -728,11 +728,9 @@ checkPat loc _ _
 
 checkAPat :: DynFlags -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
 checkAPat dynflags loc e = case e of
-   EWildPat           -> return (WildPat placeHolderType)
-   HsVar x | isQual x  -> parseError loc ("Qualified variable in pattern: "
-                                        ++ showRdrName x)
-          | otherwise -> return (VarPat x)
-   HsLit l            -> return (LitPat l)
+   EWildPat -> return (WildPat placeHolderType)
+   HsVar x  -> return (VarPat x)
+   HsLit l  -> return (LitPat l)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
@@ -792,9 +790,15 @@ checkAPat dynflags loc e = case e of
    HsType ty          -> return (TypePat ty) 
    _                  -> patFail loc
 
-plus_RDR, bang_RDR :: RdrName
+placeHolderPunRhs :: HsExpr RdrName
+-- The RHS of a punned record field will be filled in by the renamer
+-- It's better not to make it an error, in case we want to print it when debugging
+placeHolderPunRhs = HsVar pun_RDR
+
+plus_RDR, bang_RDR, pun_RDR :: RdrName
 plus_RDR = mkUnqual varName (fsLit "+")        -- Hack
 bang_RDR = mkUnqual varName (fsLit "!")        -- Hack
+pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
 
 checkPatField :: HsRecField RdrName (LHsExpr RdrName) -> P (HsRecField RdrName (LPat RdrName))
 checkPatField fld = do { p <- checkLPat (hsRecFieldArg fld)
@@ -831,10 +835,6 @@ checkFunBind :: SrcSpan
              -> Located (GRHSs RdrName)
              -> P (HsBind RdrName)
 checkFunBind lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
-  | isQual (unLoc fun)
-  = parseErrorSDoc (getLoc fun) 
-       (ptext (sLit "Qualified name in function definition:") <+> ppr (unLoc fun))
-  | otherwise
   = do ps <- checkPatterns pats
        let match_span = combineSrcSpans lhs_loc rhs_span
        return (makeFunBind fun is_infix [L match_span (Match ps opt_sig grhss)])