[Git][ghc/ghc][wip/sand-witch/check- at -binders] Apply suggestions about rnPats and mention Note [tcMatchPats] everywhere

Andrei Borzenkov (@sand-witch) gitlab at gitlab.haskell.org
Thu Feb 8 12:15:21 UTC 2024



Andrei Borzenkov pushed to branch wip/sand-witch/check- at -binders at Glasgow Haskell Compiler / GHC


Commits:
64275024 by Andrei Borzenkov at 2024-02-08T16:15:05+04:00
Apply suggestions about rnPats and mention Note [tcMatchPats] everywhere

- - - - -


5 changed files:

- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Gen/Pat.hs


Changes:

=====================================
compiler/GHC/HsToCore/Arrows.hs
=====================================
@@ -533,6 +533,7 @@ dsCmd ids local_vars stack_ty res_ty
                              , m_grhss = GRHSs _ [L _ (GRHS _ [] body)] _ })]) }))
         env_ids
   = dsCmdLam ids local_vars stack_ty res_ty (expectVisPats pats) body env_ids
+    -- Why expectViPats? See Note [tcMatchPats] in GHC.Tc.Gen.Pat
 
 dsCmd ids local_vars stack_ty res_ty
       (HsCmdLam _ lam_variant match at MG { mg_ext = MatchGroupTc {mg_arg_tys = arg_tys} } )


=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -786,6 +786,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches'
                                               (\a b -> (scaledMult a, unLoc b))
                                                 arg_tys
                                                 (expectVisPats $ hsLMatchPats m))
+                            -- Why expectViPats? See Note [tcMatchPats] in GHC.Tc.Gen.Pat
 
         -- Pattern match check warnings for /this match-group/.
         -- @rhss_nablas@ is a flat list of covered Nablas for each RHS.
@@ -819,6 +820,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches'
     mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo
     mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas)
       = do { dflags <- getDynFlags
+             -- Why expectViPats? See Note [tcMatchPats] in GHC.Tc.Gen.Pat
            ; let upats = map (decideBangHood dflags) (expectVisPats pats)
            -- pat_nablas is the covered set *after* matching the pattern, but
            -- before any of the GRHSs. We extend the environment with pat_nablas


=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1726,10 +1726,9 @@ the choice in ExpandedThingRn, but it seems simpler to consult the flag (again).
 -- Building representations of auxiliary structures like Match, Clause, Stmt,
 
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
-repMatchTup (L _ (Match { m_pats = [ap]
+repMatchTup (L _ (Match { m_pats = [L _ (VisPat _ p)]
                         , m_grhss = GRHSs _ guards wheres })) =
-  do { let [p] = expectVisPats [ap]
-     ; ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
+  do { ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
      ; (ss2,ds) <- repBinds wheres
@@ -1737,7 +1736,7 @@ repMatchTup (L _ (Match { m_pats = [ap]
      ; gs    <- repGuards guards
      ; match <- repMatch p1 gs ds
      ; wrapGenSyms (ss1++ss2) match }}}
-repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
+repMatchTup _ = panic "repMatchTup: case alt with more than one arg or with invisible pattern"
 
 repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause))
 repClauseTup (L _ (Match { m_pats = ps


=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -411,13 +411,26 @@ There are various entry points to renaming patterns, depending on
  we export the three points in this design space that we actually need:
 -}
 
-rnArgPats :: HsMatchContextRn -> [LArgPat GhcPs] -> ([LArgPat GhcRn] -> RnM (a, FreeVars)) -> RnM (a, FreeVars)
-rnArgPats ctxt pats thing_inside = do
+-- ----------- Entry point 1: rnPats -------------------
+-- Binds local names; the scope of the bindings is entirely in the thing_inside
+--   * allows type sigs to bind type vars
+--   * local namemaker
+--   * unused and duplicate checking
+--   * no fixities
+
+rn_pats_general :: Traversable f =>
+  (NameMaker -> f (LocatedA (pat GhcPs)) -> CpsRn  (f (LocatedA (pat GhcRn))))
+  -> (CollectFlag GhcRn -> [LocatedA (pat GhcRn)] -> [Name])
+  -> HsMatchContextRn
+  -> f (LocatedA (pat GhcPs))
+  -> (f (LocatedA (pat GhcRn)) -> RnM (r, FreeVars))
+  -> RnM (r, FreeVars)
+rn_pats_general rn_pats_and_then collect_pats_binders ctxt pats thing_inside = do
   envs_before <- getRdrEnvs
 
   -- (1) rename the patterns, bringing into scope all of the term variables
   -- (2) then do the thing inside.
-  unCpsRn (rnLArgPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
+  unCpsRn (rn_pats_and_then (matchNameMaker ctxt) pats) $ \ pats' -> do
     -- Check for duplicated and shadowed names
     -- Must do this *after* renaming the patterns
     -- See Note [Collect binders only after renaming] in GHC.Hs.Utils
@@ -427,7 +440,7 @@ rnArgPats ctxt pats thing_inside = do
     --    complain *twice* about duplicates e.g. f (x,x) = ...
     --
     -- See Note [Don't report shadowing for pattern synonyms]
-    let bndrs = collectLArgPatsBinders CollVarTyVarBinders (toList pats')
+    let bndrs = collect_pats_binders CollVarTyVarBinders (toList pats')
     addErrCtxt doc_pat $
       if isPatSynCtxt ctxt
          then checkDupNames bndrs
@@ -435,41 +448,20 @@ rnArgPats ctxt pats thing_inside = do
     thing_inside pats'
   where
     doc_pat = text "In" <+> pprMatchContext ctxt
+{-# INLINE rn_pats_general #-}
+
+rnArgPats :: HsMatchContextRn
+          -> [LArgPat GhcPs]
+          -> ([LArgPat GhcRn] -> RnM (a, FreeVars))
+          -> RnM (a, FreeVars)
+rnArgPats = rn_pats_general rnLArgPatsAndThen collectLArgPatsBinders
 
--- ----------- Entry point 1: rnPats -------------------
--- Binds local names; the scope of the bindings is entirely in the thing_inside
---   * allows type sigs to bind type vars
---   * local namemaker
---   * unused and duplicate checking
---   * no fixities
 rnPats :: Traversable f
        => HsMatchContextRn   -- For error messages
        -> f (LPat GhcPs)
        -> (f (LPat GhcRn) -> RnM (a, FreeVars))
        -> RnM (a, FreeVars)
-rnPats ctxt pats thing_inside
-  = do  { envs_before <- getRdrEnvs
-
-          -- (1) rename the patterns, bringing into scope all of the term variables
-          -- (2) then do the thing inside.
-        ; unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
-        { -- Check for duplicated and shadowed names
-          -- Must do this *after* renaming the patterns
-          -- See Note [Collect binders only after renaming] in GHC.Hs.Utils
-          -- Because we don't bind the vars all at once, we can't
-          --    check incrementally for duplicates;
-          -- Nor can we check incrementally for shadowing, else we'll
-          --    complain *twice* about duplicates e.g. f (x,x) = ...
-          --
-          -- See Note [Don't report shadowing for pattern synonyms]
-        ; let bndrs = collectPatsBinders CollVarTyVarBinders (toList pats')
-        ; addErrCtxt doc_pat $
-          if isPatSynCtxt ctxt
-             then checkDupNames bndrs
-             else checkDupAndShadowedNames envs_before bndrs
-        ; thing_inside pats' } }
-  where
-    doc_pat = text "In" <+> pprMatchContext ctxt
+rnPats = rn_pats_general (mapM . rnLPatAndThen) collectPatsBinders
 {-# SPECIALIZE rnPats :: HsMatchContextRn -> [LPat GhcPs] -> ([LPat GhcRn] -> RnM (a, FreeVars)) -> RnM (a, FreeVars) #-}
 {-# SPECIALIZE rnPats :: HsMatchContextRn -> Identity (LPat GhcPs) -> (Identity (LPat GhcRn) -> RnM (a, FreeVars)) -> RnM (a, FreeVars) #-}
 
@@ -522,7 +514,7 @@ rnLArgPatsAndThen mk = mapM (wrapSrcSpanCps rnArgPatAndThen) where
 -- ----------- Entry point 3: rnLPatAndThen -------------------
 -- General version: parameterized by how you make new names
 
-rnLPatsAndThen :: Traversable f => NameMaker -> f (LPat GhcPs) -> CpsRn (f (LPat GhcRn))
+rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn]
 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
   -- Despite the map, the monad ensures that each pattern binds
   -- variables that may be mentioned in subsequent patterns in the list


=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -205,42 +205,6 @@ tcMatchPats match_ctxt pats pat_tys thing_inside
     is_vis_arg_pat (L _ VisPat{}) = True
     is_vis_arg_pat _ = False
 
-{- Note [Type-checking invisible type patterns: check mode]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-GHC Proposal #448 introduced invisible type patterns that correspond to
-`forall a.` in types. Since these patters are invisible, user can mention
-them or just ignore in case they don't need to bring new type variable
-into scope. I.e., this code is fine:
-
-  f :: forall a b c. Bool -> ...
-  f @ta @tb True  = ... -- `ta` corresponds to `a`, `tb` - to `b`, `c` is not mentioned
-  f         False = ... -- no type patterns needs to be checked
-
-For type checking these patterns in check mode we need to
-  1) Collect all the type variables in `forall`s with Invisible SpecifiedSpec binders
-     as they are our expected pattern types.
-  2) Filter out from collected expected type patterns all that don't correspond to
-     invisible type pattern in function/lambda.
-
-GHC implements eager scolemisation. That means, that type variables in `forall.` would
-be instantiated a long before we start checking type patterns. As a workaround we collect
-information about scolemised `forall`s in functions `tcSkolemiseScopedExpPatTys`,
-`tcTopSkolemiseExpPatTys` and `tcSkolemiseExpType` and propagate collected information
-in `Check` data constructor of `ExpType` type.
-
-Filtering of collected type patterns is implemented in `filter_exp_tys` function
-inside of `tcArgType`, where we have both expected pattern types and actual argument
-patterns.
-
-Notice, that we may collect more pattern types then we need in current match, but we
-should not drop them, because we may have such code:
-
-  f :: forall a b c. ...
-  f @ta @tb = \ @tc -> ...
-
-Instead, we add the rest of expected types to the inner expected type to propagate
-them deeper.
--}
 
 tcInferPat :: FixedRuntimeRepContext
            -> HsMatchContextRn



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6427502423980003d057f70778bd1ef9be35a1c8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6427502423980003d057f70778bd1ef9be35a1c8
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/20240208/989492a7/attachment-0001.html>


More information about the ghc-commits mailing list