Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Use HsTupleTy [] for unit tuples, uniformly

This is just a tidy-up triggered by #5719.  We were parsing () as a
type constructor, rather than as a HsTupleTy, but it's better dealt
with uniformly as the former, I think.  Somewhat a matter of taste.
  • Loading branch information...
commit 416c5903f3b8cf4cdd4a03c8949489df18cd790a 1 parent 8785726
@simonpj simonpj authored
View
13 compiler/hsSyn/HsTypes.lhs
@@ -195,6 +195,19 @@ mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
mkHsOpTy ty1 op ty2 = HsOpTy ty1 (WpKiApps [], op) ty2
\end{code}
+Note [Unit tuples]
+~~~~~~~~~~~~~~~~~~
+Consider the type
+ type instance F Int = ()
+We want to parse that "()"
+ as HsTupleTy HsBoxedOrConstraintTuple [],
+NOT as HsTyVar unitTyCon
+
+Why? Because F might have kind (* -> Constraint), so we when parsing we
+don't know if that tuple is going to be a constraint tuple or an ordinary
+unit tuple. The HsTupleSort flag is specifically designed to deal with
+that, but it has to work for unit tuples too.
+
Note [Promotions (HsTyVar)]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
HsTyVar: A name in a type or kind.
View
30 compiler/parser/Parser.y.pp
@@ -1047,20 +1047,22 @@
| atype { $1 }
atype :: { LHsType RdrName }
- : gtycon { L1 (HsTyVar (unLoc $1)) }
- | tyvar { L1 (HsTyVar (unLoc $1)) }
- | strict_mark atype { LL (HsBangTy (unLoc $1) $2) } -- Constructor sigs only
- | '{' fielddecls '}' {% checkRecordSyntax (LL $ HsRecTy $2) } -- Constructor sigs only
- | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy HsBoxedOrConstraintTuple ($2:$4) }
- | '(#' comma_types1 '#)' { LL $ HsTupleTy HsUnboxedTuple $2 }
- | '[' ctype ']' { LL $ HsListTy $2 }
- | '[:' ctype ':]' { LL $ HsPArrTy $2 }
- | '(' ctype ')' { LL $ HsParTy $2 }
- | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 }
- | quasiquote { L1 (HsQuasiQuoteTy (unLoc $1)) }
- | '$(' exp ')' { LL $ mkHsSpliceTy $2 }
- | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $
- mkUnqual varName (getTH_ID_SPLICE $1) }
+ : ntgtycon { L1 (HsTyVar (unLoc $1)) } -- Not including unit tuples
+ | tyvar { L1 (HsTyVar (unLoc $1)) } -- (See Note [Unit tuples])
+ | strict_mark atype { LL (HsBangTy (unLoc $1) $2) } -- Constructor sigs only
+ | '{' fielddecls '}' {% checkRecordSyntax (LL $ HsRecTy $2) } -- Constructor sigs only
+ | '(' ')' { LL $ HsTupleTy HsBoxedOrConstraintTuple [] }
+ | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy HsBoxedOrConstraintTuple ($2:$4) }
+ | '(#' '#)' { LL $ HsTupleTy HsUnboxedTuple [] }
+ | '(#' comma_types1 '#)' { LL $ HsTupleTy HsUnboxedTuple $2 }
+ | '[' ctype ']' { LL $ HsListTy $2 }
+ | '[:' ctype ':]' { LL $ HsPArrTy $2 }
+ | '(' ctype ')' { LL $ HsParTy $2 }
+ | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 }
+ | quasiquote { L1 (HsQuasiQuoteTy (unLoc $1)) }
+ | '$(' exp ')' { LL $ mkHsSpliceTy $2 }
+ | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $
+ mkUnqual varName (getTH_ID_SPLICE $1) }
-- see Note [Promotion] for the followings
| SIMPLEQUOTE qconid { LL $ HsTyVar $ unLoc $2 }
| SIMPLEQUOTE '(' ')' { LL $ HsTyVar $ getRdrName unitDataCon }
View
22 compiler/parser/RdrHsSyn.lhs
@@ -56,7 +56,7 @@ import BasicTypes ( maxPrecedence, Activation(..), RuleMatchInfo,
InlinePragma(..), InlineSpec(..) )
import TcEvidence ( idHsWrapper )
import Lexer
-import TysWiredIn ( unitTyCon )
+import TysWiredIn ( unitTyCon, unitDataCon )
import ForeignCall
import OccName ( srcDataName, varName, isDataOcc, isTcOcc,
occNameString )
@@ -360,10 +360,12 @@ splitCon :: LHsType RdrName
splitCon ty
= split ty []
where
- split (L _ (HsAppTy t u)) ts = split t (u : ts)
- split (L l (HsTyVar tc)) ts = do data_con <- tyConToDataCon l tc
- return (data_con, mk_rest ts)
- split (L l _) _ = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
+ split (L _ (HsAppTy t u)) ts = split t (u : ts)
+ split (L l (HsTyVar tc)) ts = do data_con <- tyConToDataCon l tc
+ return (data_con, mk_rest ts)
+ split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon [])
+ -- See Note [Unit tuples] in HsTypes
+ split (L l _) _ = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
mk_rest [L _ (HsRecTy flds)] = RecCon flds
mk_rest ts = PrefixCon ts
@@ -535,12 +537,13 @@ checkTyClHdr ty
goL (L l ty) acc = go l ty acc
go l (HsTyVar tc) acc
- | isRdrTc tc = return (L l tc, acc)
-
+ | isRdrTc tc = return (L l tc, acc)
go _ (HsOpTy t1 (_, ltc@(L _ tc)) t2) acc
| isRdrTc tc = return (ltc, t1:t2:acc)
go _ (HsParTy ty) acc = goL ty acc
go _ (HsAppTy t1 t2) acc = goL t1 (t2:acc)
+ go l (HsTupleTy _ []) [] = return (L l (getRdrName unitTyCon), [])
+ -- See Note [Unit tuples] in HsTypes
go l _ _ = parseErrorSDoc l (text "Malformed head of type or class declaration:" <+> ppr ty)
-- Check that associated type declarations of a class are all kind signatures.
@@ -560,14 +563,11 @@ checkContext (L l orig_t)
= check orig_t
where
check (HsTupleTy _ ts) -- (Eq a, Ord b) shows up as a tuple type
- = return (L l ts)
+ = return (L l ts) -- Ditto ()
check (HsParTy ty) -- to be sure HsParTy doesn't get into the way
= check (unLoc ty)
- check (HsTyVar t) -- Empty context shows up as a unit type ()
- | t == getRdrName unitTyCon = return (L l [])
-
check _
= return (L l [L l orig_t])
View
12 compiler/typecheck/TcHsType.lhs
@@ -349,14 +349,10 @@ kc_hs_type (HsParTy ty) exp_kind = do
ty' <- kc_lhs_type ty exp_kind
return (HsParTy ty')
-kc_hs_type (HsTyVar name) exp_kind
- -- Special case for the unit tycon so it benefits from kind overloading
- | name == tyConName unitTyCon
- = kc_hs_type (HsTupleTy HsBoxedOrConstraintTuple []) exp_kind
- | otherwise = do
- (ty, k) <- kcTyVar name
- checkExpectedKind ty k exp_kind
- return ty
+kc_hs_type (HsTyVar name) exp_kind = do
+ (ty, k) <- kcTyVar name
+ checkExpectedKind ty k exp_kind
+ return ty
kc_hs_type (HsListTy ty) exp_kind = do
ty' <- kcLiftedType ty
Please sign in to comment.
Something went wrong with that request. Please try again.