diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index 703a0acaa4843fe1d42e6dcb5790c65857d97fe1..62a8a285c51f7a10bceca60cc9b4f2caf616eabe 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -10,16 +10,13 @@ module HsExpr where
-- friends:
import HsBinds ( HsBinds(..), nullBinds )
-import HsTypes ( PostTcType )
import HsLit ( HsLit, HsOverLit )
import BasicTypes ( Fixity(..) )
-import HsTypes ( HsType )
+import HsTypes ( HsType, PostTcType, SyntaxName )
import HsImpExp ( isOperator )
-- others:
-import Name ( Name )
import ForeignCall ( Safety )
-import Outputable
import PprType ( pprParendType )
import Type ( Type )
import Var ( TyVar )
@@ -27,6 +24,7 @@ import DataCon ( DataCon )
import CStrings ( CLabelString, pprCLabelString )
import BasicTypes ( IPName, Boxity, tupleParens )
import SrcLoc ( SrcLoc )
+import Outputable
import FastString
\end{code}
@@ -62,7 +60,7 @@ data HsExpr id pat
-- They are eventually removed by the type checker.
| NegApp (HsExpr id pat) -- negated expr
- Name -- Name of 'negate' (see RnEnv.lookupSyntaxName)
+ SyntaxName -- Name of 'negate' (see RnEnv.lookupSyntaxName)
| HsPar (HsExpr id pat) -- parenthesised expr
diff --git a/ghc/compiler/hsSyn/HsLit.lhs b/ghc/compiler/hsSyn/HsLit.lhs
index 2675810465a228eb14fc6714c65c5eceff7cae07..03dd717c6e64056f9479964f23c54c373024827a 100644
--- a/ghc/compiler/hsSyn/HsLit.lhs
+++ b/ghc/compiler/hsSyn/HsLit.lhs
@@ -9,8 +9,7 @@ module HsLit where
#include "HsVersions.h"
import Type ( Type )
-import Name ( Name )
-import HsTypes ( PostTcType )
+import HsTypes ( SyntaxName, PostTcType )
import Outputable
import FastString
import Ratio ( Rational )
@@ -58,9 +57,9 @@ instance Eq HsLit where
lit1 == lit2 = False
data HsOverLit -- An overloaded literal
- = HsIntegral Integer Name -- Integer-looking literals;
+ = HsIntegral Integer SyntaxName -- Integer-looking literals;
-- The name is fromInteger
- | HsFractional Rational Name -- Frac-looking literals
+ | HsFractional Rational SyntaxName -- Frac-looking literals
-- The name is fromRational
instance Eq HsOverLit where
diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
index 10e22b8a8a565a6f95999b3c571cf285739afe0b..6f0cc212c0039ed7a1077ac2ba4abaada46d88ed 100644
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ b/ghc/compiler/hsSyn/HsPat.lhs
@@ -22,7 +22,7 @@ module HsPat (
-- friends:
import HsLit ( HsLit, HsOverLit )
import HsExpr ( HsExpr )
-import HsTypes ( HsType )
+import HsTypes ( HsType, SyntaxName )
import BasicTypes ( Fixity, Boxity, tupleParens )
-- others:
@@ -55,13 +55,12 @@ data InPat name
(InPat name)
| NPatIn HsOverLit -- Always positive
- (Maybe Name) -- Just (Name of 'negate') for negative
+ (Maybe SyntaxName) -- Just (Name of 'negate') for negative
-- patterns, Nothing otherwise
- -- (see RnEnv.lookupSyntaxName)
| NPlusKPatIn name -- n+k pattern
HsOverLit -- It'll always be an HsIntegral
- Name -- Name of '-' (see RnEnv.lookupSyntaxName)
+ SyntaxName -- Name of '-' (see RnEnv.lookupSyntaxName)
-- We preserve prefix negation and parenthesis for the precedence parser.
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 738ab167eab0da86db32ce4b2ad2ef064e0c68b2..1706134b9e799292dd6456996794e7af82d7478c 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -17,6 +17,9 @@ module HsTypes (
-- Type place holder
, PostTcType, placeHolderType,
+ -- Name place holder
+ , SyntaxName, placeHolderName,
+
-- Printing
, pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
@@ -37,17 +40,18 @@ import TcType ( Type, Kind, ThetaType, SourceType(..),
import TypeRep ( Type(..), TyNote(..) ) -- toHsType sees the representation
import TyCon ( isTupleTyCon, tupleTyConBoxity, tyConArity, isNewTyCon, getSynTyConDefn )
import RdrName ( RdrName, mkUnqual )
-import Name ( Name, getName )
-import OccName ( NameSpace, tvName )
+import Name ( Name, getName, mkInternalName )
+import OccName ( NameSpace, mkVarOcc, tvName )
import Var ( TyVar, tyVarKind )
import Subst ( substTyWith )
import PprType ( {- instance Outputable Kind -}, pprParendKind, pprKind )
import BasicTypes ( Boxity(..), Arity, IPName, tupleParens )
import PrelNames ( mkTupConRdrName, listTyConKey, parrTyConKey,
- usOnceTyConKey, usManyTyConKey, hasKey,
+ usOnceTyConKey, usManyTyConKey, hasKey, unboundKey,
usOnceTyConName, usManyTyConName )
-import FiniteMap
+import SrcLoc ( builtinSrcLoc )
import Util ( eqListBy, lengthIs )
+import FiniteMap
import Outputable
\end{code}
@@ -66,6 +70,18 @@ type PostTcType = Type -- Used for slots in the abstract syntax
placeHolderType :: PostTcType -- Used before typechecking
placeHolderType = panic "Evaluated the place holder for a PostTcType"
+
+
+type SyntaxName = Name -- These names are filled in by the renamer
+ -- Before then they are a placeHolderName (so that
+ -- we can still print the HsSyn)
+ -- They correspond to "rebindable syntax";
+ -- See RnEnv.lookupSyntaxName
+
+placeHolderName :: SyntaxName
+placeHolderName = mkInternalName unboundKey
+ (mkVarOcc FSLIT("syntaxPlaceHolder"))
+ builtinSrcLoc
\end{code}
diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 6f8bd63415434ff27de1f924d3679dde78675fcd..374a441f151fd56e67301271241c3a1867b24789 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -62,14 +62,11 @@ module RdrHsSyn (
import HsSyn -- Lots of it
import OccName ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc,
mkSuperDictSelOcc, mkDefaultMethodOcc, mkGenOcc1,
- mkGenOcc2, mkVarOcc
+ mkGenOcc2
)
-import PrelNames ( unboundKey )
-import Name ( mkInternalName )
import RdrName ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc, isRdrTyVar )
import List ( nub )
import BasicTypes ( RecFlag(..) )
-import SrcLoc ( builtinSrcLoc )
import Class ( DefMeth (..) )
\end{code}
@@ -262,10 +259,6 @@ mkHsIntegral i = HsIntegral i placeHolderName
mkHsFractional f = HsFractional f placeHolderName
mkNPlusKPat n k = NPlusKPatIn n k placeHolderName
mkHsDo ctxt stmts loc = HsDo ctxt stmts [] placeHolderType loc
-
-placeHolderName = mkInternalName unboundKey
- (mkVarOcc FSLIT("syntaxPlaceHolder"))
- builtinSrcLoc
\end{code}
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index fd08c0f5204830ff55c58603eb1bd5ee11fa7b23..bc63e44a5cfc75662c59474469611444322269b2 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -95,9 +95,9 @@ rnPat (LitPatIn lit)
rnPat (NPatIn lit mb_neg)
= rnOverLit lit `thenRn` \ (lit', fvs1) ->
(case mb_neg of
- Nothing -> returnRn (Nothing, emptyFVs)
- Just neg -> lookupSyntaxName neg `thenRn` \ neg' ->
- returnRn (Just neg', unitFV neg')
+ Nothing -> returnRn (Nothing, emptyFVs)
+ Just _ -> lookupSyntaxName negateName `thenRn` \ neg ->
+ returnRn (Just neg, unitFV neg)
) `thenRn` \ (mb_neg', fvs2) ->
returnRn (NPatIn lit' mb_neg',
fvs1 `plusFV` fvs2 `addOneFV` eqClassName)