[Git][ghc/ghc][wip/T20264] 2 commits: Use lambda, not let, in WorkWrap
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Dec 24 12:34:32 UTC 2024
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
ebce3d42 by Simon Peyton Jones at 2024-12-24T12:05:22+00:00
Use lambda, not let, in WorkWrap
Using type let did not work right with type lets and shadowing
Requires Lint to be OK join points under beta redexes -- but it is!
Needs better documentation
- - - - -
818eeaa3 by Simon Peyton Jones at 2024-12-24T12:06:41+00:00
Wibbles
- - - - -
7 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Utils.hs
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -476,6 +476,13 @@ Wrinkles:
is well-typed. This is used during worker/wrapper, which creates type-lets.
See GHC.Core.Opt.WorkWrap.Utils.mkAppsBeta.
+(TCL2) Consider a beta-redex ((/\a. blah) ty). We may turn that into
+ let @a = ty in blah
+ and it's crucial that /every/ occurrence of `a` in `blah` is replaced by
+ `a{=ty}` with an unfolding. To ensure that, we extend the /substitution/
+ (which is always substituted) with the tyvar-replete-with-unfolding, rather
+ than merely extending the in-scope set as we do for Ids.
+
Note [Core top-level string literals]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As an exception to the usual rule that top-level binders must be lifted,
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -914,7 +914,7 @@ lintCoreExpr (Let (NonRec tv (Type rhs_ty)) body)
| isTyVar tv
= -- See Note [Linting type lets]
do { case tyVarUnfolding_maybe tv of
- Nothing -> return () -- See Note [Overview of type lets] wrinkle (TCL1)
+ Nothing -> return () -- See GHC.Core Note [Type and coercion lets] wrinkle (TCL1)
Just unf_ty -> -- These comparisons compare InTypes, which is fine
do { ensureEqTys (tyVarKind tv) (typeKind rhs_ty) $
tv_err unf_ty "Let-bound tyvar kind incompatible with RHS:"
@@ -1467,8 +1467,7 @@ subtype of the required type, as one would expect.
-- e.g. f :: Int -> Bool -> Int would return `Int` as result type.
lintCoreArgs :: (OutType, UsageEnv) -> [InExpr] -> LintM (OutType, UsageEnv)
lintCoreArgs (fun_ty, fun_ue) args
- = lintApp (text "expression")
- lintTyArg lintValArg fun_ty args fun_ue
+ = lintApp (text "expression") lintTyArg lintValArg fun_ty args fun_ue
lintTyArg :: InExpr -> LintM OutType
=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -1781,9 +1781,8 @@ mkAbsLamTypes abs_vars ty
-- , text "res" <+> ppr res ])
res
where
- res = expandTyVarUnfoldings (mkVarEnv tv_unf_prs) (mkLamTypes abs_lam_vars ty)
- abs_lam_vars = [ v | v <- abs_vars, isNothing (tyVarUnfolding_maybe v) ]
- tv_unf_prs = [ (tv,ty) | tv <- abs_vars, Just ty <- [tyVarUnfolding_maybe tv] ]
+ res = expandTyVarUnfoldings (mkVarSet tvs_w_unfs) (mkLamTypes abs_lam_vars ty)
+ (abs_lam_vars, tvs_w_unfs) = partition (isNothing . tyVarUnfolding_maybe) abs_vars
mkAbsVarApps :: Expr LevelledBndr -> AbsVars -> Expr LevelledBndr
mkAbsVarApps fun [] = fun
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -306,6 +306,11 @@ completeTyVarBindX env in_tv out_ty
= do { (env1, out_tv) <- simplTyVarBndr env in_tv
; let out_tv_w_unf = out_tv `setTyVarUnfolding` out_ty
env2 = extendTvSubst env1 in_tv (mkTyVarTy out_tv_w_unf)
+ -- NB: Put the in_tv :-> out_tv_w_unf in the (compulsory)
+ -- substitution, so that it guarantees to replace every
+ -- occurrence of in_tv. After all, in a beta-redex, in_tv
+ -- had no unfolding. See (TCL2) in
+ -- Note [Type and coercion lets] in GHC.Core
; return (mkFloatBind env2 (NonRec out_tv_w_unf (Type out_ty))) }
{-
=====================================
compiler/GHC/Core/Opt/WorkWrap/Utils.hs
=====================================
@@ -282,7 +282,7 @@ mkWwBodies opts fun_id ww_arity arg_vars res_ty demands res_cpr
mkAppsBeta :: CoreExpr -> [CoreArg] -> CoreExpr
-- The precondition holds for our call site in mkWwBodies, because all the FVs
-- of as are either cloned_arg_vars (and thus fresh) or fresh worker args.
-mkAppsBeta (Lam b body) (a:as) = bindNonRec b a $! mkAppsBeta body as
+-- mkAppsBeta (Lam b body) (a:as) = bindNonRec b a $! mkAppsBeta body as
mkAppsBeta f as = mkApps f as
-- See Note [Limit w/w arity]
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -508,15 +508,15 @@ on its fast path must also be inlined, linked back to this Note.
* *
********************************************************************* -}
-expandTyVarUnfoldings :: TyVarEnv Type -> Type -> Type
--- (expandTyvarUnfoldings tvs ty) replace any occurrences of `tvs` in `ty`
+expandTyVarUnfoldings :: TyVarSet -> Type -> Type
+-- (expandTyVarUnfoldings tvs ty) replace any occurrences of `tvs` in `ty`
-- with their unfoldings. The returned type does not mention any of `tvs`.
--
-- There are no substitution or variable-capture issues: if we have (let @a = ty
--- in body), then at all occurrences of `a` the free vars of `body` are also in
--- scope, without having been shadowed.
+-- in body), then at all occurrences of `a` in `body`, the free vars of `ty` are
+-- also in scope, without having been shadowed.
expandTyVarUnfoldings tvs ty
- | isEmptyVarEnv tvs = ty
+ | isEmptyVarSet tvs = ty
| otherwise = runIdentity (expand ty)
where
expand :: Type -> Identity Type
@@ -524,9 +524,9 @@ expandTyVarUnfoldings tvs ty
= mapTyCo (TyCoMapper { tcm_tyvar = exp_tv, tcm_covar = exp_cv
, tcm_hole = exp_hole, tcm_tycobinder = exp_tcb
, tcm_tycon = pure })
- exp_tv _ tv = case lookupVarEnv tvs tv of
- Just ty -> expand ty
- Nothing -> pure (TyVarTy tv)
+ exp_tv _ tv = case tyVarUnfolding_maybe tv of
+ Just ty | tv `elemVarSet` tvs -> expand ty
+ _ -> pure (TyVarTy tv)
exp_cv _ cv = pure (CoVarCo cv)
exp_hole _ cv = pprPanic "expand_tv_unf" (ppr cv)
exp_tcb :: () -> TyCoVar -> ForAllTyFlag -> (() -> TyCoVar -> Identity r) -> Identity r
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -129,9 +129,11 @@ exprType :: HasDebugCallStack => CoreExpr -> Type
-- ^ Recover the type of a well-typed Core expression. Fails when
-- applied to the actual 'GHC.Core.Type' expression as it cannot
-- really be said to have a type
-exprType e = go emptyVarEnv e
+exprType e = go emptyVarSet e
where
- -- When we get to a type, expand locally-bound tyvars, if any
+ -- When we get to a type, expand locally-bound tyvars, if any
+ -- For example, exprType (let @a{=Int} = Int in Nothing @(a,b))
+ -- should return (Maybe (Int,b)), having expanded out the `a`
expand = expandTyVarUnfoldings
go tvs (Var var) = expand tvs $ idType var
@@ -139,7 +141,7 @@ exprType e = go emptyVarEnv e
go tvs (Coercion co) = expand tvs $ coercionType co
go tvs (Let bind body)
| NonRec tv rhs <- bind -- See Note [Type bindings]
- , Type ty <- rhs = go (extendVarEnv tvs tv ty) body
+ , Type {} <- rhs = go (tvs `extendVarSet` tv) body
| otherwise = go tvs body
go tvs (Case _ _ ty _) = expand tvs ty
go tvs (Cast _ co) = expand tvs $ coercionRKind co
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb17f57d4a93b837f29734c33dc0d7ac77c71e6c...818eeaa30f6894e2d67692198d39900d351b0ff5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb17f57d4a93b837f29734c33dc0d7ac77c71e6c...818eeaa30f6894e2d67692198d39900d351b0ff5
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/20241224/a52e7609/attachment-0001.html>
More information about the ghc-commits
mailing list