Skip to content

Commit cc31887

Browse files
AshleyYakeleympickering
AshleyYakeley
authored and
mpickering
committed
Support TypeInType
1 parent 1a0eb8f commit cc31887

17 files changed

+244
-416
lines changed

‎src/Language/Haskell/Exts/ExactPrint.hs

Lines changed: 1 addition & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1037,42 +1037,6 @@ instance ExactP TyVarBind where
10371037
[] -> exactPC n
10381038
_ -> errorEP "ExactP: TyVarBind: UnkindedVar is given wrong number of srcInfoPoints"
10391039

1040-
instance ExactP Kind where
1041-
exactP kd' = case kd' of
1042-
KindStar _ -> printString "*"
1043-
KindFn l k1 k2 ->
1044-
case srcInfoPoints l of
1045-
[a] -> do
1046-
exactP k1
1047-
printStringAt (pos a) "->"
1048-
exactPC k2
1049-
_ -> errorEP "ExactP: Kind: KindFn is given wrong number of srcInfoPoints"
1050-
KindParen l kd ->
1051-
case srcInfoPoints l of
1052-
[_,b] -> do
1053-
printString "("
1054-
exactPC kd
1055-
printStringAt (pos b) ")"
1056-
_ -> errorEP "ExactP: Kind: KindParen is given wrong number of srcInfoPoints"
1057-
KindVar _ n -> epQName n
1058-
KindApp _ k1 k2 -> do
1059-
exactP k1
1060-
exactPC k2
1061-
KindTuple l ks ->
1062-
let o = "("
1063-
e = ")"
1064-
pts = srcInfoPoints l
1065-
in printInterleaved (zip pts (o: replicate (length pts - 2) "," ++ [e])) ks
1066-
KindList l k ->
1067-
case srcInfoPoints l of
1068-
[_, close] -> do
1069-
printString "["
1070-
exactPC k
1071-
printStringAt (pos close) "]"
1072-
_ -> errorEP "ExactP: Kind: KindList is given wrong number of srcInfoPoints"
1073-
1074-
1075-
10761040
instance ExactP Type where
10771041
exactP t' = case t' of
10781042
TyForall l mtvs mctxt t -> do
@@ -1089,6 +1053,7 @@ instance ExactP Type where
10891053
_ -> errorEP "ExactP: Type: TyForall is given too few srcInfoPoints"
10901054
maybeEP exactPC mctxt
10911055
exactPC t
1056+
TyStar _ -> printString "*"
10921057
TyFun l t1 t2 ->
10931058
case srcInfoPoints l of
10941059
[a] -> do

‎src/Language/Haskell/Exts/InternalParser.ly

Lines changed: 89 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,9 @@ Pragmas
291291
> '{-# COMPLETE' { Loc $$ COMPLETE }
292292
> '#-}' { Loc $$ PragmaEnd } -- 139
293293

294+
Utility
295+
296+
> NEVER { Loc $$@SrcSpan{srcSpanStartLine= -1} _ } -- never-matching terminal of type SrcSpan
294297

295298
> %monad { P }
296299
> %lexer { lexer } { Loc _ EOF }
@@ -941,57 +944,70 @@ Type equality contraints need the TypeFamilies extension.
941944
> : dtype {% checkType $1 }
942945

943946
> dtype :: { PType L }
944-
> : btype { splitTilde $1 }
945-
> | btype qtyconop dtype { TyInfix ($1 <> $3) $1 $2 $3 }
946-
> | btype qtyvarop dtype { TyInfix ($1 <> $3) $1 (UnpromotedName (ann $2) $2) $3 } -- FIXME
947-
> | btype '->' ctype { TyFun ($1 <> $3 <** [$2]) (splitTilde $1) $3 }
948-
| btype '~' btype {% do { checkEnabledOneOf [TypeFamilies, GADTs] ;
949-
let {l = $1 <> $3 <** [$2]};
950-
return $ TyPred l $ EqualP l $1 $3 } }
947+
> : dtype_('*',NEVER) { $1 }
948+
949+
> dtype_(ostar,kstar) :: { PType L }
950+
> : btype_(ostar,kstar) { splitTilde $1 }
951+
> | btype_(ostar,kstar) qtyconop dtype_(ostar,kstar) { TyInfix ($1 <> $3) $1 $2 $3 }
952+
> | btype_(ostar,kstar) qtyvarop_(ostar) dtype_(ostar,kstar) { TyInfix ($1 <> $3) $1 (UnpromotedName (ann $2) $2) $3 } -- FIXME
953+
> | btype_(ostar,kstar) '->' ctype_(ostar,kstar) { TyFun ($1 <> $3 <** [$2]) (splitTilde $1) $3 }
954+
| btype_(ostar,kstar) '~' btype_(ostar,kstar) {% do { checkEnabledOneOf [TypeFamilies, GADTs] ;
955+
let {l = $1 <> $3 <** [$2]};
956+
return $ TyPred l $ EqualP l $1 $3 } }
951957

952958
Implicit parameters can occur in normal types, as well as in contexts.
953959

954960
> truetype :: { Type L }
955961
> : type {% checkType $1 }
956962

957963
> type :: { PType L }
958-
> : ivar '::' dtype { let l = ($1 <> $3 <** [$2]) in TyPred l $ IParam l $1 $3 }
959-
> | dtype { $1 }
964+
> : type_('*',NEVER) { $1 }
965+
966+
> type_(ostar,kstar) :: { PType L }
967+
> : ivar '::' dtype_(ostar,kstar) { let l = ($1 <> $3 <** [$2]) in TyPred l $ IParam l $1 $3 }
968+
> | dtype_(ostar,kstar) { $1 }
960969

961970
> truebtype :: { Type L }
962971
> : btype {% checkType (splitTilde $1) }
963972
> trueatype :: { Type L }
964973
> : atype {% checkType $1 }
965974

966975
> btype :: { PType L }
967-
> : btype atype { TyApp ($1 <> $2) $1 $2 }
968-
> | atype { $1 }
976+
> : btype_('*',NEVER) { $1 }
977+
978+
> btype_(ostar,kstar) :: { PType L }
979+
> : btype_(ostar,kstar) atype_(ostar,kstar) { TyApp ($1 <> $2) $1 $2 }
980+
> | atype_(ostar,kstar) { $1 }
969981

970982
UnboxedTuples requires the extension, but that will be handled through
971983
the (# and #) lexemes. Kinds will be handled at the kind rule.
972984

973985
> atype :: { PType L }
974-
> : gtycon { TyCon (ann $1) $1 }
986+
> : atype_('*',NEVER) { $1 }
987+
988+
> atype_(ostar,kstar) :: { PType L }
989+
> : kstar { TyStar (nIS $1) }
990+
> | gtycon_(ostar) { TyCon (ann $1) $1 }
975991
> | tyvar {% checkTyVar $1 }
976992
> | strict_mark atype { let (mstrict, mupack) = $1
977993
> in bangType mstrict mupack $2 }
978-
> | '(' types ')' { TyTuple ($1 <^^> $3 <** ($1:reverse ($3:snd $2))) Boxed (reverse (fst $2)) }
979-
> | '(#' types_bars2 '#)' { TyUnboxedSum ($1 <^^> $3 <** ($1: reverse ($3: snd $2))) (reverse (fst $2)) }
980-
> | '(#' types1 '#)' { TyTuple ($1 <^^> $3 <** ($1:reverse ($3:snd $2))) Unboxed (reverse (fst $2)) }
981-
> | '[' type ']' { TyList ($1 <^^> $3 <** [$1,$3]) $2 }
982-
> | '[:' type ':]' { TyParArray ($1 <^^> $3 <** [$1,$3]) $2 }
983-
> | '(' ctype ')' { TyParen ($1 <^^> $3 <** [$1,$3]) $2 }
984-
> | '(' ctype '::' kind ')' { TyKind ($1 <^^> $5 <** [$1,$3,$5]) $2 $4 }
994+
> | '(' types_(ostar,kstar) ')' { TyTuple ($1 <^^> $3 <** ($1:reverse ($3:snd $2))) Boxed (reverse (fst $2)) }
995+
> | '(#' types_bars2(ostar,kstar) '#)' { TyUnboxedSum ($1 <^^> $3 <** ($1: reverse ($3: snd $2))) (reverse (fst $2)) }
996+
> | '(#' types1_(ostar,kstar) '#)' { TyTuple ($1 <^^> $3 <** ($1:reverse ($3:snd $2))) Unboxed (reverse (fst $2)) }
997+
> | '[' type_(ostar,kstar) ']' { TyList ($1 <^^> $3 <** [$1,$3]) $2 }
998+
> | '[:' type_(ostar,kstar) ':]' { TyParArray ($1 <^^> $3 <** [$1,$3]) $2 }
999+
> | '(' ctype_(ostar,kstar) ')' { TyParen ($1 <^^> $3 <** [$1,$3]) $2 }
1000+
> | '(' ctype_(ostar,kstar) '::' kind ')' { TyKind ($1 <^^> $5 <** [$1,$3,$5]) $2 $4 }
9851001
> | '$(' trueexp ')' { let l = ($1 <^^> $3 <** [$1,$3]) in TySplice l $ ParenSplice l $2 }
9861002
> | IDSPLICE { let Loc l (THIdEscape s) = $1 in TySplice (nIS l) $ IdSplice (nIS l) s }
9871003
> | '_' { TyWildCard (nIS $1) Nothing }
9881004
> | QUASIQUOTE { let Loc l (THQuasiQuote (n,q)) = $1 in TyQuasiQuote (nIS l) n q }
989-
> | ptype { % checkEnabled DataKinds >> return (TyPromoted (ann $1) $1) }
1005+
> | ptype_(ostar,kstar) { % checkEnabled DataKinds >> return (TyPromoted (ann $1) $1) }
9901006

991-
> ptype :: { Promoted L }
992-
> : VARQUOTE gcon_nolist {% fmap (PromotedCon (nIS $1 <++> ann $2 <** [$1]) True) (pexprToQName $2) }
993-
> | VARQUOTE '[' types1 ']' {% PromotedList ($1 <^^> $4 <** ($1:reverse($4:snd $3))) True . reverse <\$> mapM checkType (fst $3) }
994-
> | '[' types ']' {% PromotedList ($1 <^^> $3 <** ($1:reverse($3:snd $2))) False . reverse <\$> mapM checkType (fst $2) }
1007+
> ptype_(ostar,kstar) :: { Promoted L }
1008+
> : VARQUOTE gcon_nolist {% fmap (PromotedCon (nIS $1 <++> ann $2 <** [$1]) True) (pexprToQName $2) }
1009+
> | VARQUOTE '[' types1_(ostar,kstar) ']' {% PromotedList ($1 <^^> $4 <** ($1:reverse($4:snd $3))) True . reverse <\$> mapM checkType (fst $3) }
1010+
> | '[' types_(ostar,kstar) ']' {% PromotedList ($1 <^^> $3 <** ($1:reverse($3:snd $2))) False . reverse <\$> mapM checkType (fst $2) }
9951011
> | VARQUOTE '[' ']' { PromotedList ($1 <^^> $3 <** [$1, $3]) True [] }
9961012
| '[' ']' {% PromotedList ($1 <^^> $2 <** [$1, $2]) False [] }
9971013
> | VARQUOTE '(' types1 ')' {% PromotedTuple ($1 <^^> $4 <** ($1:reverse($4:snd $3))) . reverse <\$> mapM checkType (fst $3) }
@@ -1014,7 +1030,10 @@ the (# and #) lexemes. Kinds will be handled at the kind rule.
10141030

10151031

10161032
> gtycon :: { QName L }
1017-
> : otycon { $1 }
1033+
> : gtycon_('*') { $1 }
1034+
1035+
> gtycon_(ostar) :: { QName L }
1036+
> : otycon_(ostar) { $1 }
10181037
> | '(' ')' { unit_tycon_name ($1 <^^> $2 <** [$1,$2]) }
10191038
> | '(' '->' ')' { fun_tycon_name ($1 <^^> $3 <** [$1,$2,$3]) }
10201039
> | '[' ']' { list_tycon_name ($1 <^^> $2 <** [$1,$2]) }
@@ -1023,9 +1042,12 @@ the (# and #) lexemes. Kinds will be handled at the kind rule.
10231042
> | '(#' commas '#)' { tuple_tycon_name ($1 <^^> $3 <** ($1:reverse $2 ++ [$3])) Unboxed (length $2) }
10241043

10251044
> otycon :: { QName L }
1045+
> : otycon_('*') { $1 }
1046+
1047+
> otycon_(ostar) :: { QName L }
10261048
> : qconid { $1 }
10271049
> | '(' gconsym ')' { updateQNameLoc ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3]) $2 }
1028-
> | '(' qvarsym ')' { updateQNameLoc ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3]) $2 }
1050+
> | '(' qvarsym_(ostar) ')' { updateQNameLoc ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3]) $2 }
10291051

10301052
These are for infix types
10311053

@@ -1051,25 +1073,37 @@ is any of the keyword-enabling ones, except ExistentialQuantification.
10511073
> : ctype {% checkType $1 }
10521074

10531075
> ctype :: { PType L }
1054-
> : 'forall' ktyvars '.' ctype { mkTyForall (nIS $1 <++> ann $4 <** [$1,$3]) (Just (reverse (fst $2))) Nothing $4 }
1055-
> | context ctype { mkTyForall ($1 <> $2) Nothing (Just $1) $2 }
1056-
> | type { $1 }
1076+
> : ctype_('*',NEVER) { $1 }
1077+
1078+
> ctype_(ostar,kstar) :: { PType L }
1079+
> : 'forall' ktyvars '.' ctype_(ostar,kstar) { mkTyForall (nIS $1 <++> ann $4 <** [$1,$3]) (Just (reverse (fst $2))) Nothing $4 }
1080+
> | context_(ostar,kstar) ctype_(ostar,kstar) { mkTyForall ($1 <> $2) Nothing (Just $1) $2 }
1081+
> | type_(ostar,kstar) { $1 }
10571082

10581083
Equality constraints require the TypeFamilies extension.
10591084

10601085
> context :: { PContext L }
1061-
> : btype '=>' {% checkPContext $ (amap (\l -> l <++> nIS $2 <** (srcInfoPoints l ++ [$2]))) (splitTilde $1) }
1086+
> : context_('*',NEVER) { $1 }
1087+
1088+
> context_(ostar,kstar) :: { PContext L }
1089+
> : btype_(ostar,kstar) '=>' {% checkPContext $ (amap (\l -> l <++> nIS $2 <** (srcInfoPoints l ++ [$2]))) (splitTilde $1) }
10621090

10631091
> types :: { ([PType L],[S]) }
1064-
> : types1 ',' ctype { ($3 : fst $1, $2 : snd $1) }
1092+
> : types_('*',NEVER) { $1 }
1093+
1094+
> types_(ostar,kstar) :: { ([PType L],[S]) }
1095+
> : types1_(ostar,kstar) ',' ctype_(ostar,kstar) { ($3 : fst $1, $2 : snd $1) }
10651096

10661097
> types1 :: { ([PType L],[S]) }
1067-
> : ctype { ([$1],[]) }
1068-
> | types1 ',' ctype { ($3 : fst $1, $2 : snd $1) }
1098+
> : types1_('*',NEVER) { $1 }
10691099

1070-
> types_bars2 :: { ([PType L],[S]) }
1071-
> : ctype '|' ctype { ([$3, $1], [$2]) }
1072-
> | types_bars2 '|' ctype { ($3 : fst $1, $2 : snd $1) }
1100+
> types1_(ostar,kstar) :: { ([PType L],[S]) }
1101+
> : ctype_(ostar,kstar) { ([$1],[]) }
1102+
> | types1_(ostar,kstar) ',' ctype_(ostar,kstar) { ($3 : fst $1, $2 : snd $1) }
1103+
1104+
> types_bars2(ostar,kstar) :: { ([PType L],[S]) }
1105+
> : ctype_(ostar,kstar) '|' ctype_(ostar,kstar) { ([$3, $1], [$2]) }
1106+
> | types_bars2(ostar,kstar) '|' ctype_(ostar,kstar) { ($3 : fst $1, $2 : snd $1) }
10731107

10741108
> ktyvars :: { ([TyVarBind L],Maybe L) }
10751109
> : ktyvars ktyvar { ($2 : fst $1, Just (snd $1 <?+> ann $2)) }
@@ -1210,32 +1244,7 @@ Kinds
12101244
> : kind1 {% checkEnabled KindSignatures >> return $1 }
12111245

12121246
> kind1 :: { Kind L }
1213-
> : bkind { $1 }
1214-
> | bkind '->' kind1 { KindFn ($1 <> $3 <** [$2]) $1 $3 }
1215-
1216-
> bkind :: { Kind L }
1217-
> : akind { $1 }
1218-
> | bkind akind { KindApp ($1 <> $2) $1 $2 }
1219-
1220-
> akind :: { Kind L }
1221-
> : '*' { KindStar (nIS $1) }
1222-
> | '(' kind1 ')' { KindParen ($1 <^^> $3 <** [$1,$3]) $2 }
1223-
> | pkind {% checkKind $1 >> return $1 }
1224-
> | qvarid {% checkEnabled PolyKinds >> return (KindVar (ann $1) $1) }
1225-
1226-
KindParen covers 1-tuples, KindVar l while KindTuple is for pairs
1227-
1228-
> pkind :: { Kind L }
1229-
> : qtyconorcls { KindVar (ann $1) $1 }
1230-
> | '(' ')' { let l = $1 <^^> $2 in KindVar l (unit_tycon_name l) }
1231-
> | '(' kind ',' comma_kinds1 ')'
1232-
> { KindTuple ($1 <^^> $5 <** ($1:$3:reverse ($5:snd $4))) ($2:reverse (fst $4)) }
1233-
> | '[' kind ']' { KindList (($1 <^^> $3) <** [$1, $3]) $2 }
1234-
1235-
> comma_kinds1 :: { ([Kind L], [S]) }
1236-
> : kind1 { ([$1], []) }
1237-
> | kind1 ',' comma_kinds1 { ($1 : (fst $3), $2 : (snd $3)) }
1238-
1247+
> : dtype_(NEVER,'*') {% checkType $1 }
12391248

12401249
> optkind :: { (Maybe (Kind L), [S]) }
12411250
> : {-empty-} { (Nothing,[]) }
@@ -2002,22 +2011,31 @@ Implicit parameter
20022011
> : CONSYM { let Loc l (ConSym c) = $1 in Symbol (nIS l) c }
20032012

20042013
> qvarsym :: { QName L }
2005-
> : varsym { UnQual (ann $1) $1 }
2014+
> : qvarsym_('*') { $1 }
2015+
2016+
> qvarsym_(ostar) :: { QName L }
2017+
> : varsym_(ostar) { UnQual (ann $1) $1 }
20062018
> | qvarsym1 { $1 }
20072019

20082020
> qvarsymm :: { QName L }
20092021
> : varsymm { UnQual (ann $1) $1 }
20102022
> | qvarsym1 { $1 }
20112023

20122024
> varsym :: { Name L }
2013-
> : varsymm { $1 }
2025+
> : varsym_('*') { $1 }
2026+
2027+
> varsym_(ostar) :: { Name L }
2028+
> : varsymm_(ostar) { $1 }
20142029
> | '-' { minus_name (nIS $1) }
20152030

2016-
> varsymm :: { Name L } -- varsym not including '-'
2031+
> varsymm :: { Name L }
2032+
> : varsymm_('*') { $1 }
2033+
2034+
> varsymm_(ostar) :: { Name L } -- varsym not including '-'
20172035
> : VARSYM { let Loc l (VarSym v) = $1 in Symbol (nIS l) v }
20182036
> | '!' { bang_name (nIS $1) }
20192037
> | '.' { dot_name (nIS $1) }
2020-
> | '*' { star_name (nIS $1) }
2038+
> | ostar { star_name (nIS $1) }
20212039

20222040
> qvarsym1 :: { QName L }
20232041
> : QVARSYM { let {Loc l (QVarSym q) = $1; nis = nIS l} in Qual nis (ModuleName nis (fst q)) (Symbol nis (snd q)) }
@@ -2155,14 +2173,14 @@ Miscellaneous (mostly renamings)
21552173
| 'forall' { forall_name (nIS $1) }
21562174
| 'family' { family_name (nIS $1) }
21572175

2158-
> qtyvarop :: { QName L }
2159-
> qtyvarop : '`' tyvar '`' { UnQual ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3]) $2 }
2160-
> | tyvarsym { UnQual (ann $1) $1 }
2176+
> qtyvarop_(ostar) :: { QName L }
2177+
> qtyvarop_ : '`' tyvar '`' { UnQual ($1 <^^> $3 <** [$1, srcInfoSpan (ann $2), $3]) $2 }
2178+
> | tyvarsym_(ostar) { UnQual (ann $1) $1 }
21612179

2162-
> tyvarsym :: { Name L }
2180+
> tyvarsym_(ostar) :: { Name L }
21632181
> tyvarsym : VARSYM { let Loc l (VarSym x) = $1 in Symbol (nIS l) x }
21642182
> | '-' { Symbol (nIS $1) "-" }
2165-
> | '*' { Symbol (nIS $1) "*" }
2183+
> | ostar { Symbol (nIS $1) "*" }
21662184

21672185
> impdeclsblock :: { ([ImportDecl L],[S],L) }
21682186
> : '{' optsemis impdecls optsemis '}' { let (ids, ss) = $3 in (ids, $1 : reverse $2 ++ ss ++ reverse $4 ++ [$5], $1 <^^> $5) }

‎src/Language/Haskell/Exts/ParseSyntax.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -300,6 +300,7 @@ data PType l
300300
(Maybe [TyVarBind l])
301301
(Maybe (PContext l))
302302
(PType l)
303+
| TyStar l -- ^ @*@, the type of types
303304
| TyFun l (PType l) (PType l) -- ^ function type
304305
| TyTuple l Boxed [PType l] -- ^ tuple type, possibly boxed
305306
| TyUnboxedSum l [PType l] -- ^ unboxed sum
@@ -322,6 +323,7 @@ data PType l
322323
instance Annotated PType where
323324
ann t = case t of
324325
TyForall l _ _ _ -> l
326+
TyStar l -> l
325327
TyFun l _ _ -> l
326328
TyTuple l _ _ -> l
327329
TyUnboxedSum l _ -> l
@@ -341,6 +343,7 @@ instance Annotated PType where
341343
TyQuasiQuote l _ _ -> l
342344
amap f t' = case t' of
343345
TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t
346+
TyStar l -> TyStar (f l)
344347
TyFun l t1 t2 -> TyFun (f l) t1 t2
345348
TyTuple l b ts -> TyTuple (f l) b ts
346349
TyUnboxedSum l ts -> TyUnboxedSum (f l) ts

‎src/Language/Haskell/Exts/ParseUtils.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1107,6 +1107,7 @@ checkT t simple = case t of
11071107
checkEnabled ExplicitForAll
11081108
ctxt <- checkContext cs
11091109
check1Type pt (S.TyForall l tvs ctxt)
1110+
TyStar l -> return $ S.TyStar l
11101111
TyFun l at rt -> check2Types at rt (S.TyFun l)
11111112
TyTuple l b pts -> checkTypes pts >>= return . S.TyTuple l b
11121113
TyUnboxedSum l es -> checkTypes es >>= return . S.TyUnboxedSum l
@@ -1177,9 +1178,9 @@ checkTyVar n = do
11771178
-- test for that.
11781179
checkKind :: Kind l -> P ()
11791180
checkKind k = case k of
1180-
KindVar _ q | constrKind q -> checkEnabledOneOf [ConstraintKinds, DataKinds]
1181+
S.TyVar _ q | constrKind q -> checkEnabledOneOf [ConstraintKinds, DataKinds]
11811182
where constrKind name = case name of
1182-
(UnQual _ (Ident _ n)) -> n == "Constraint"
1183+
Ident _ n -> n == "Constraint"
11831184
_ -> False
11841185

11851186
_ -> checkEnabled DataKinds

‎src/Language/Haskell/Exts/Pretty.hs

Lines changed: 2 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -833,6 +833,7 @@ prec_atype = 2 -- argument of type or data constructor, or of a class
833833
instance Pretty (Type l) where
834834
prettyPrec p (TyForall _ mtvs ctxt htype) = parensIf (p > 0) $
835835
myFsep [ppForall mtvs, maybePP pretty ctxt, pretty htype]
836+
prettyPrec _ (TyStar _) = text "*"
836837
prettyPrec p (TyFun _ a b) = parensIf (p > 0) $
837838
myFsep [ppBType a, text "->", pretty b]
838839
prettyPrec _ (TyTuple _ bxd l) =
@@ -894,16 +895,6 @@ ppForall (Just vs) = myFsep (text "forall" : map pretty vs ++ [char '.'])
894895

895896
---------------------------- Kinds ----------------------------
896897

897-
instance Pretty (Kind l) where
898-
prettyPrec _ KindStar{} = text "*"
899-
prettyPrec n (KindFn _ a b) = parensIf (n > 0) $ myFsep [prettyPrec 1 a, text "->", pretty b]
900-
prettyPrec _ (KindParen _ k) = parens $ pretty k
901-
prettyPrec _ (KindVar _ n) = pretty n
902-
prettyPrec _ (KindTuple _ t) = parenList . map pretty $ t
903-
prettyPrec _ (KindList _ l) = brackets . pretty $ l
904-
prettyPrec n (KindApp _ a b) =
905-
parensIf (n > 3) $ myFsep [prettyPrec 3 a, prettyPrec 4 b]
906-
907898
ppOptKind :: Maybe (Kind l) -> [Doc]
908899
ppOptKind Nothing = []
909900
ppOptKind (Just k) = [text "::", pretty k]
@@ -1670,6 +1661,7 @@ instance SrcInfo loc => Pretty (P.PAsst loc) where
16701661
instance SrcInfo loc => Pretty (P.PType loc) where
16711662
prettyPrec p (P.TyForall _ mtvs ctxt htype) = parensIf (p > 0) $
16721663
myFsep [ppForall mtvs, maybePP pretty ctxt, pretty htype]
1664+
prettyPrec _ (P.TyStar _) = text "*"
16731665
prettyPrec p (P.TyFun _ a b) = parensIf (p > 0) $
16741666
myFsep [prettyPrec prec_btype a, text "->", pretty b]
16751667
prettyPrec _ (P.TyTuple _ bxd l) =

0 commit comments

Comments
 (0)