Skip to content

Commit

Permalink
Use HsTupleTy [] for unit tuples, uniformly
Browse files Browse the repository at this point in the history 
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
Simon Peyton Jones committed Dec 23, 2011
1 parent 8785726 commit 416c590
Show file tree
Hide file tree
Showing 4 changed files with 44 additions and 33 deletions.
13 changes: 13 additions & 0 deletions compiler/hsSyn/HsTypes.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
30 changes: 16 additions & 14 deletions compiler/parser/Parser.y.pp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down
22 changes: 11 additions & 11 deletions compiler/parser/RdrHsSyn.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -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])
Expand Down
12 changes: 4 additions & 8 deletions compiler/typecheck/TcHsType.lhs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 416c590

Please sign in to comment.