[Git][ghc/ghc][wip/T21623] Wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Aug 23 22:23:00 UTC 2022
Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC
Commits:
a7c161b7 by Simon Peyton Jones at 2022-08-23T23:23:17+01:00
Wibbles
- - - - -
6 changed files:
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Types/Id/Make.hs
- testsuite/tests/typecheck/should_run/TypeOf.stdout
- testsuite/tests/typecheck/should_run/TypeRep.stdout
Changes:
=====================================
compiler/GHC/Core/TyCo/Rep.hs
=====================================
@@ -1124,6 +1124,7 @@ mkScaledFunTys tys ty = foldr (mkScaledFunTy af) ty tys
tcMkScaledFunTys :: [Scaled Type] -> Type -> Type
-- All visible args
-- Result type must be TypeLike
+-- No mkFunTy assert checking; result kind may not be zonked
tcMkScaledFunTys tys ty = foldr mk ty tys
where
mk (Scaled mult arg) res = tcMkVisFunTy mult arg res
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -3970,7 +3970,7 @@ tcHsPartialSigType ctxt sig_ty
-- No kind-generalization here:
; kindGeneralizeNone (mkInvisForAllTys outer_tv_bndrs $
- mkPhiTy theta $
+ tcMkPhiTy theta $
tau)
-- Spit out the wildcards (including the extra-constraints one)
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -3415,8 +3415,8 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map
; let tc_tvs = binderVars tc_bndrs
fake_ty = mkSpecForAllTys tc_tvs $
mkInvisForAllTys exp_tvbndrs $
- mkPhiTy ctxt $
- tcMkScaledFunTys arg_tys $
+ tcMkPhiTy ctxt $
+ tcMkScaledFunTys arg_tys $
unitTy
-- That type is a lie, of course. (It shouldn't end in ()!)
-- And we could construct a proper result type from the info
@@ -3521,8 +3521,8 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map
; tkvs <- kindGeneralizeAll skol_info
(mkInvisForAllTys outer_tv_bndrs $
- mkPhiTy ctxt $
- tcMkScaledFunTys arg_tys $
+ tcMkPhiTy ctxt $
+ tcMkScaledFunTys arg_tys $
res_ty)
; traceTc "tcConDecl:GADT" (ppr names $$ ppr res_ty $$ ppr tkvs)
; reportUnsolvedEqualities skol_info tkvs tclvl wanted
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -310,14 +310,15 @@ for symmetry with the way data instances are handled.
Note [Newtype datacons]
~~~~~~~~~~~~~~~~~~~~~~~
-The "data constructor" for a newtype should always be vanilla. At one
-point this wasn't true, because the newtype arising from
+The "data constructor" for a newtype should have no existentials. It's
+not quite a "vanilla" data constructor, because the newtype arising from
class C a => D a
-looked like
- newtype T:D a = D:D (C a)
-so the data constructor for T:C had a single argument, namely the
-predicate (C a). But now we treat that as an ordinary argument, not
-part of the theta-type, so all is well.
+looks like
+ newtype T:D a = C:D (C a)
+so the data constructor for T:C has a single argument, namely the
+predicate (C a). That ends up in the dcOtherTheta for the data con,
+which makes it not vanilla. So the assert just tests for existentials.
+The rest is checked by having a singleton arg_tys.
Note [Newtype workers]
~~~~~~~~~~~~~~~~~~~~~~
@@ -590,8 +591,10 @@ mkDataConWorkId wkr_name data_con
wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike }
wkr_arity = dataConRepArity data_con
+
----------- Workers for newtypes --------------
univ_tvs = dataConUnivTyVars data_con
+ ex_tcvs = dataConExTyCoVars data_con
arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys
nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
`setArityInfo` 1 -- Arity 1
@@ -599,8 +602,8 @@ mkDataConWorkId wkr_name data_con
`setUnfoldingInfo` newtype_unf
id_arg1 = mkScaledTemplateLocal 1 (head arg_tys)
res_ty_args = mkTyCoVarTys univ_tvs
- newtype_unf = assertPpr (isVanillaDataCon data_con && isSingleton arg_tys)
- (ppr data_con) $
+ newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys)
+ (ppr data_con)
-- Note [Newtype datacons]
mkCompulsoryUnfolding defaultSimpleOpts $
mkLams univ_tvs $ Lam id_arg1 $
=====================================
testsuite/tests/typecheck/should_run/TypeOf.stdout
=====================================
@@ -9,7 +9,7 @@ SomeTypeRep
Bool
Ordering
Int -> Int
-Proxy Constraint (Eq Int)
+Proxy (CONSTRAINT ('BoxedRep 'Lifted)) (Eq Int)
Proxy * (Int,Int)
Proxy Symbol "hello world"
Proxy Natural 1
@@ -24,4 +24,4 @@ Proxy Levity 'Lifted
Proxy Levity 'Unlifted
Proxy RuntimeRep ('BoxedRep 'Lifted)
Proxy (Natural,Symbol) ('(,) Natural Symbol 1 "hello")
-Proxy (* -> * -> Constraint) ((~~) * *)
+Proxy (* -> * -> CONSTRAINT ('BoxedRep 'Lifted)) ((~~) * *)
=====================================
testsuite/tests/typecheck/should_run/TypeRep.stdout
=====================================
@@ -14,7 +14,7 @@ Int -> Int
Int#
(##)
(#,#) 'IntRep ('BoxedRep 'Lifted) Int# Int
-Proxy Constraint (Eq Int)
+Proxy (CONSTRAINT ('BoxedRep 'Lifted)) (Eq Int)
Proxy * (Int,Int)
Proxy Symbol "hello world"
Proxy Natural 1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c161b7d5bb12110204852fdb3fcbb5907cbd17
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c161b7d5bb12110204852fdb3fcbb5907cbd17
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220823/338f9353/attachment-0001.html>
More information about the ghc-commits
mailing list