[Git][ghc/ghc][wip/T24676] Small wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Mon Apr 29 22:45:06 UTC 2024
Simon Peyton Jones pushed to branch wip/T24676 at Glasgow Haskell Compiler / GHC
Commits:
ac999ca4 by Simon Peyton Jones at 2024-04-29T23:44:12+01:00
Small wibbles
- - - - -
3 changed files:
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Utils/TcMType.hs
Changes:
=====================================
compiler/GHC/Core/TyCo/FVs.hs
=====================================
@@ -230,6 +230,17 @@ then we won't look at it at all. If it is free, then all the variables free in i
kind are free -- regardless of whether some local variable has the same Unique.
So if we're looking at a variable occurrence at all, then all variables in its
kind are free.
+
+Note [Free vars and synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When finding free variables we generally do not expand synonyms. So given
+ type T a = Int
+the type (T [b]) will return `b` as a free variable, even though expanding the
+synonym would get rid of it. Expanding synonyms might lead to types that look
+ill-scoped; an alternative we have not explored.
+
+But see `occCheckExpand` in this module for a function that does, selectively,
+expand synonyms to reduce free-var occurences.
-}
{- *********************************************************************
@@ -319,7 +330,7 @@ deep_cos :: [Coercion] -> Endo TyCoVarSet
(deep_ty, deep_tys, deep_co, deep_cos) = foldTyCo deepTcvFolder emptyVarSet
deepTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
-deepTcvFolder = TyCoFolder { tcf_view = noView
+deepTcvFolder = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms]
, tcf_tyvar = do_tcv, tcf_covar = do_tcv
, tcf_hole = do_hole, tcf_tycobinder = do_bndr }
where
@@ -377,7 +388,7 @@ shallow_cos :: [Coercion] -> Endo TyCoVarSet
(shallow_ty, shallow_tys, shallow_co, shallow_cos) = foldTyCo shallowTcvFolder emptyVarSet
shallowTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
-shallowTcvFolder = TyCoFolder { tcf_view = noView
+shallowTcvFolder = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms]
, tcf_tyvar = do_tcv, tcf_covar = do_tcv
, tcf_hole = do_hole, tcf_tycobinder = do_bndr }
where
@@ -587,6 +598,7 @@ tyCoFVsOfType (TyVarTy v) f bound_vars (acc_list, acc_set)
emptyVarSet -- See Note [Closing over free variable kinds]
(v:acc_list, extendVarSet acc_set v)
tyCoFVsOfType (TyConApp _ tys) f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc
+ -- See Note [Free vars and synonyms]
tyCoFVsOfType (LitTy {}) f bound_vars acc = emptyFV f bound_vars acc
tyCoFVsOfType (AppTy fun arg) f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc
tyCoFVsOfType (FunTy _ w arg res) f bound_vars acc = (tyCoFVsOfType w `unionFV` tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc
@@ -944,7 +956,9 @@ invisibleVarsOfTypes = mapUnionFV invisibleVarsOfType
{-# INLINE afvFolder #-} -- so that specialization to (const True) works
afvFolder :: (TyCoVar -> Bool) -> TyCoFolder TyCoVarSet DM.Any
-afvFolder check_fv = TyCoFolder { tcf_view = noView
+-- 'afvFolder' is short for "any-free-var folder", good for checking
+-- if any free var of a type satisfies a predicate `check_fv`
+afvFolder check_fv = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms]
, tcf_tyvar = do_tcv, tcf_covar = do_tcv
, tcf_hole = do_hole, tcf_tycobinder = do_bndr }
where
@@ -993,12 +1007,13 @@ instance Monad m => Monoid (AnyM m) where
{-# INLINE afvFolderM #-} -- so that specialization to (const True) works
afvFolderM :: Monad m => (TyCoVar -> m Bool) -> TyCoFolder TyCoVarSet (AnyM m)
-afvFolderM check_fv = TyCoFolder { tcf_view = noView
+-- A monadic variant of `afvFolder` where the predicate is monadic
+afvFolderM check_fv = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms]
, tcf_tyvar = do_tv, tcf_covar = mempty
, tcf_hole = mempty, tcf_tycobinder = do_bndr }
where
do_bndr is tcv _ = extendVarSet is tcv
- do_tv is tv | tv `elemVarSet` is = AM (return False)
+ do_tv is tv | tv `elemVarSet` is = mempty
| otherwise = AM (check_fv tv)
anyFreeVarsOfTypeM :: Monad m => (TyCoVar -> m Bool) -> Type -> m Bool
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -1515,7 +1515,7 @@ This turned out to be more subtle than I expected. Wrinkles:
(QLA1) We avoid zonking, so quickLookArg thereby sees the argument type /before/
the QL substitution Theta is applied to it. So we achieve argument-order
- independence for free (see 5.7 in the paper). See the `guarded` predictate
+ independence for free (see 5.7 in the paper). See the `guarded` predicate
in `quickLookArg`.
(QLA2) `quickLookArg` decides whether or not premises (A) and (B) of the
@@ -1544,7 +1544,7 @@ This turned out to be more subtle than I expected. Wrinkles:
(QLA4) When we resume typechecking an argument, in `tcValArg`, it's fairly
easy if eaql_status=QLUnified (see (QLA2)). But for QLIndependent things
- are a bit tricky; see function `resume_ql-arg`:
+ are a bit tricky; see function `resume_ql_arg`:
- quickLookArg has not yet done `qlUnify` with the calling context. We
must do so now. Example: choose [] ids,
@@ -1565,7 +1565,7 @@ This turned out to be more subtle than I expected. Wrinkles:
EValArgQL. We carefully kept those kappas, and we now /demote/ them to the
ambient level with `demoteQLDelta`.
- The demotion seems right butis not very beautiful; e.g. `demoteDeltaTyVarTo`
+ The demotion seems right but is not very beautiful; e.g. `demoteDeltaTyVarTo`
deliberately disobeys a sanity check otherwise enforced by writeMetaTyVar.
-}
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -2465,17 +2465,15 @@ demoteQLDelta :: TcTyVarSet -> TcM ()
-- See Note [Quick Look at value arguments] wrinkle (QLA4)
-- in GHC.Tc.Gen.App
demoteQLDelta delta
- | null tvs
- = return ()
- | otherwise
- = do { tclvl <- getTcLevel
- ; assertPpr (isMetaTyVar tv1) (ppr delta) $
- when (tclvl `strictlyDeeperThan` tcTyVarLevel tv1) $
- mapM_ (demoteDeltaTyVarTo tclvl) tvs }
+ = case tvs of
+ [] -> return ()
+ (tv1:_) -> do { tclvl <- getTcLevel
+ ; assertPpr (isMetaTyVar tv1) (ppr delta) $
+ when (tclvl `strictlyDeeperThan` tcTyVarLevel tv1) $
+ mapM_ (demoteDeltaTyVarTo tclvl) tvs }
where
- tv1 = head tvs
tvs = nonDetEltsUniqSet delta
- -- Non-determinism is OK because order of promotion doesn't matter
+ -- Non-determinism is OK because order of demotion doesn't matter
{-
%************************************************************************
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac999ca4e4ecda1bd6e8077ccfff4fdbca50b0b5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac999ca4e4ecda1bd6e8077ccfff4fdbca50b0b5
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/20240429/1da975da/attachment-0001.html>
More information about the ghc-commits
mailing list