diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-12-03 11:30:22 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-12-03 13:42:40 +0000 |
| commit | 03d4852658e1b7407abb4da84b1b03bfa6f6db3b (patch) | |
| tree | f957494f1aa0933f71a783c5e006f2f03d807a58 /compiler/typecheck/TcUnify.hs | |
| parent | 89d80921d9328499ffca9877e7dea540350be9c1 (diff) | |
| download | haskell-03d4852658e1b7407abb4da84b1b03bfa6f6db3b.tar.gz | |
Introduce tcTypeKind, and use it
In the type checker Constraint and * are distinct; and the function
that takes the kind of a type should respect that distinction
(Trac #15971).
This patch implements the change:
* Introduce Type.tcTypeKind, and use it throughout the type
inference engine
* Add new Note [Kinding rules for types] for the kinding
rules, especially for foralls.
* Redefine
isPredTy ty = tcIsConstraintKind (tcTypeKind ty)
(it had a much more complicated definition before)
Some miscellaneous refactoring
* Get rid of TyCoRep.isTYPE, Kind.isTYPEApp,
in favour of TyCoRep.kindRep, kindRep_maybe
* Rename Type.getRuntimeRepFromKind_maybe
to getRuntimeRep_maybe
I did some spot-checks on compiler perf, and it really doesn't
budge (as expected).
Diffstat (limited to 'compiler/typecheck/TcUnify.hs')
| -rw-r--r-- | compiler/typecheck/TcUnify.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index fd661c9b0e..f51c7241a8 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -440,7 +440,7 @@ matchExpectedAppTy orig_ty ; co <- unifyType Nothing (mkAppTy ty1 ty2) orig_ty ; return (co, (ty1, ty2)) } - orig_kind = typeKind orig_ty + orig_kind = tcTypeKind orig_ty kind1 = mkFunTy liftedTypeKind orig_kind kind2 = liftedTypeKind -- m :: * -> k -- arg type :: * @@ -911,7 +911,7 @@ fill_infer_result orig_ty (IR { ir_uniq = u, ir_lvl = res_lvl = do { let ty_lvl = tcTypeLevel ty ; MASSERT2( not (ty_lvl `strictlyDeeperThan` res_lvl), ppr u $$ ppr res_lvl $$ ppr ty_lvl $$ - ppr ty <+> dcolon <+> ppr (typeKind ty) $$ ppr orig_ty ) + ppr ty <+> dcolon <+> ppr (tcTypeKind ty) $$ ppr orig_ty ) ; cts <- readTcRef ref ; case cts of Just already_there -> pprPanic "writeExpType" @@ -993,12 +993,12 @@ promoteTcType dest_lvl ty dont_promote_it :: TcM (TcCoercion, TcType) dont_promote_it -- Check that ty :: TYPE rr, for some (fresh) rr = do { res_kind <- newOpenTypeKind - ; let ty_kind = typeKind ty + ; let ty_kind = tcTypeKind ty kind_orig = TypeEqOrigin { uo_actual = ty_kind , uo_expected = res_kind , uo_thing = Nothing , uo_visible = False } - ; ki_co <- uType KindLevel kind_orig (typeKind ty) res_kind + ; ki_co <- uType KindLevel kind_orig (tcTypeKind ty) res_kind ; let co = mkTcGReflRightCo Nominal ty ki_co ; return (co, ty `mkCastTy` ki_co) } @@ -1639,10 +1639,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 go dflags cur_lvl | canSolveByUnification cur_lvl tv1 ty2 , Just ty2' <- metaTyVarUpdateOK dflags tv1 ty2 - = do { co_k <- uType KindLevel kind_origin (typeKind ty2') (tyVarKind tv1) + = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) - , ppr ty2 <+> dcolon <+> ppr (typeKind ty2) + , ppr ty2 <+> dcolon <+> ppr (tcTypeKind ty2) , ppr (isTcReflCo co_k), ppr co_k ] ; if isTcReflCo co_k -- only proceed if the kinds matched. |