diff options
| -rw-r--r-- | compiler/basicTypes/OccName.lhs | 2 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 32 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 27 |
3 files changed, 44 insertions, 17 deletions
diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index ff1f71dc5c..e160d4ece9 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -492,7 +492,7 @@ isDataSymOcc _ = False -- it is a data constructor or variable or whatever) isSymOcc :: OccName -> Bool isSymOcc (OccName DataName s) = isLexConSym s -isSymOcc (OccName TcClsName s) = isLexConSym s +isSymOcc (OccName TcClsName s) = isLexConSym s || isLexVarSym s isSymOcc (OccName VarName s) = isLexSym s isSymOcc (OccName TvName s) = isLexSym s -- Pretty inefficient! diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 6e75793962..d6793920a8 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -467,17 +467,21 @@ exp_doc :: { LIE RdrName } : docsection { L1 (case (unLoc $1) of (n, doc) -> IEGroup n doc) } | docnamed { L1 (IEDocNamed ((fst . unLoc) $1)) } | docnext { L1 (IEDoc (unLoc $1)) } - + + -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { LIE RdrName } - : qvar { L1 (IEVar (unLoc $1)) } - | oqtycon { L1 (IEThingAbs (unLoc $1)) } - | oqtycon '(' '..' ')' { LL (IEThingAll (unLoc $1)) } - | oqtycon '(' ')' { LL (IEThingWith (unLoc $1) []) } - | oqtycon '(' qcnames ')' { LL (IEThingWith (unLoc $1) (reverse $3)) } + : qcname_ext export_subspec { LL (mkModuleImpExp (unLoc $1) + (unLoc $2)) } | 'module' modid { LL (IEModuleContents (unLoc $2)) } +export_subspec :: { Located ImpExpSubSpec } + : {- empty -} { L0 ImpExpAbs } + | '(' '..' ')' { LL ImpExpAll } + | '(' ')' { LL (ImpExpList []) } + | '(' qcnames ')' { LL (ImpExpList $2) } + qcnames :: { [RdrName] } : qcnames ',' qcname_ext { unLoc $3 : $1 } | qcname_ext { [unLoc $1] } @@ -485,7 +489,7 @@ qcnames :: { [RdrName] } qcname_ext :: { Located RdrName } -- Variable or data constructor -- or tagged type constructor : qcname { $1 } - | 'type' qcon { sL (comb2 $1 $2) + | 'type' qcname { sL (comb2 $1 $2) (setRdrNameSpace (unLoc $2) tcClsName) } @@ -1834,10 +1838,16 @@ tycon :: { Located RdrName } -- Unqualified qtyconsym :: { Located RdrName } : QCONSYM { L1 $! mkQual tcClsName (getQCONSYM $1) } + | QVARSYM { L1 $! mkQual tcClsName (getQVARSYM $1) } | tyconsym { $1 } +-- Does not include "!", because that is used for strictness marks +-- or ".", because that separates the quantified type vars from the rest tyconsym :: { Located RdrName } : CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) } + | VARSYM { L1 $! mkUnqual tcClsName (getVARSYM $1) } + | '*' { L1 $! mkUnqual tcClsName (fsLit "*") } + ----------------------------------------------------------------------------- -- Operators @@ -1871,11 +1881,9 @@ qvaropm :: { Located RdrName } tyvar :: { Located RdrName } tyvar : tyvarid { $1 } - | '(' tyvarsym ')' { LL (unLoc $2) } tyvarop :: { Located RdrName } tyvarop : '`' tyvarid '`' { LL (unLoc $2) } - | tyvarsym { $1 } | '.' {% parseErrorSDoc (getLoc $1) (vcat [ptext (sLit "Illegal symbol '.' in type"), ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"), @@ -1889,12 +1897,6 @@ tyvarid :: { Located RdrName } | 'safe' { L1 $! mkUnqual tvName (fsLit "safe") } | 'interruptible' { L1 $! mkUnqual tvName (fsLit "interruptible") } -tyvarsym :: { Located RdrName } --- Does not include "!", because that is used for strictness marks --- or ".", because that separates the quantified type vars from the rest --- or "*", because that's used for kinds -tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) } - ----------------------------------------------------------------------------- -- Variables diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 928eb03647..39aee7d861 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -45,12 +45,19 @@ module RdrHsSyn ( checkRecordSyntax, parseError, parseErrorSDoc, + + -- Help with processing exports + ImpExpSubSpec(..), + mkModuleImpExp + ) where import HsSyn -- Lots of it import Class ( FunDep ) import RdrName ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, - isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace ) + isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace, + rdrNameSpace ) +import OccName ( tcClsName, isVarNameSpace ) import Name ( Name ) import BasicTypes ( maxPrecedence, Activation(..), RuleMatchInfo, InlinePragma(..), InlineSpec(..) ) @@ -980,6 +987,24 @@ mkExtName :: RdrName -> CLabelString mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm)) \end{code} +-------------------------------------------------------------------------------- +-- Help with module system imports/exports + +\begin{code} +data ImpExpSubSpec = ImpExpAbs | ImpExpAll | ImpExpList [ RdrName ] + +mkModuleImpExp :: RdrName -> ImpExpSubSpec -> IE RdrName +mkModuleImpExp name subs = + case subs of + ImpExpAbs | isVarNameSpace (rdrNameSpace name) + -> IEVar name + ImpExpAbs -> IEThingAbs nameT + ImpExpAll -> IEThingAll nameT + ImpExpList xs -> IEThingWith nameT xs + + where + nameT = setRdrNameSpace name tcClsName +\end{code} ----------------------------------------------------------------------------- -- Misc utils |