Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/85926ae6c63a62e4f23423f220588875c8f1ab45 >--------------------------------------------------------------- commit 85926ae6c63a62e4f23423f220588875c8f1ab45 Author: Iavor S. Diatchki <[email protected]> Date: Sun Jan 8 16:33:51 2012 -0800 Change -XTypeOperators to treat all type-operators as type-constructors. Previously, only type operators starting with ":" were type constructors, and writing "+" in a type resulted in a type variable. Now, type variables are always ordinary identifiers, and all operators are treated as constructors. One can still write type variables in infix form though, for example, "a `fun` b" is a type expression with 3 type variables: "a", "fun", and "b". Writing (+) in an import/export list always refers to the value (+) and not the type. To refer to the type one can write either "type (+)", or provide an explicit suobrdinate list (e.g., "(+)()"). For clarity, one can also combine the two, for example "type (+)(A,B,C)" is also accepted and means the same thing as "(+)(A,B,C)" (i.e., export the type (+), with the constructors A,B,and C). >--------------------------------------------------------------- compiler/basicTypes/OccName.lhs | 2 +- compiler/parser/Parser.y.pp | 30 ++++++++++++++++-------------- compiler/parser/RdrHsSyn.lhs | 27 ++++++++++++++++++++++++++- 3 files changed, 43 insertions(+), 16 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index ff1f71d..e160d4e 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 6e75793..d679392 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -468,16 +468,20 @@ exp_doc :: { LIE RdrName } | 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 928eb03..39aee7d 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
