Commit 85926ae6 authored by Iavor S. Diatchki's avatar Iavor S. Diatchki

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).
parent f784eb75
......@@ -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!
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment