[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add missing addInScope call for letrec binders in OccurAnal

Marge Bot gitlab at gitlab.haskell.org
Mon Apr 20 02:26:29 UTC 2020



 Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
eaed0a32 by Alexis King at 2020-04-19T03:16:44-04:00
Add missing addInScope call for letrec binders in OccurAnal

This fixes #18044, where a shadowed variable was incorrectly substituted
by the binder swap on the RHS of a floated-in letrec. This can only
happen when the uniques line up *just* right, so writing a regression
test would be very difficult, but at least the fix is small and
straightforward.

- - - - -
ed8c86dc by Shayne Fletcher at 2020-04-19T22:26:21-04:00
Derive Ord instance for Extension

Metric Increase:
   T12150
   T12234

- - - - -
72fbb131 by Simon Peyton Jones at 2020-04-19T22:26:22-04:00
Fix a buglet in redundant-constraint warnings

Ticket #18036 pointed out that we were reporting a redundant
constraint when it really really wasn't.

Turned out to be a buglet in the SkolemInfo for the
relevant implication constraint.  Easily fixed!

- - - - -


7 changed files:

- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
- + testsuite/tests/typecheck/should_compile/T18036.hs
- + testsuite/tests/typecheck/should_compile/T18036a.hs
- + testsuite/tests/typecheck/should_compile/T18036a.stderr
- testsuite/tests/typecheck/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -843,7 +843,7 @@ occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage
 occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)]
                -> UsageDetails -> (UsageDetails, [CoreBind])
 occAnalRecBind env lvl imp_rule_edges pairs body_usage
-  = foldr (occAnalRec env lvl) (body_usage, []) sccs
+  = foldr (occAnalRec rhs_env lvl) (body_usage, []) sccs
         -- For a recursive group, we
         --      * occ-analyse all the RHSs
         --      * compute strongly-connected components
@@ -856,9 +856,11 @@ occAnalRecBind env lvl imp_rule_edges pairs body_usage
 
     nodes :: [LetrecNode]
     nodes = {-# SCC "occAnalBind.assoc" #-}
-            map (makeNode env imp_rule_edges bndr_set) pairs
+            map (makeNode rhs_env imp_rule_edges bndr_set) pairs
 
-    bndr_set = mkVarSet (map fst pairs)
+    bndrs    = map fst pairs
+    bndr_set = mkVarSet bndrs
+    rhs_env  = env `addInScope` bndrs
 
 {-
 Note [Unfoldings and join points]


=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -1719,19 +1719,26 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
   | Just hs_sig_ty <- hs_sig_fn sel_name
               -- There is a signature in the instance
               -- See Note [Instance method signatures]
-  = do { let ctxt = FunSigCtxt sel_name True
-       ; (sig_ty, hs_wrap)
+  = do { (sig_ty, hs_wrap)
              <- setSrcSpan (getLoc (hsSigType hs_sig_ty)) $
                 do { inst_sigs <- xoptM LangExt.InstanceSigs
                    ; checkTc inst_sigs (misplacedInstSig sel_name hs_sig_ty)
                    ; sig_ty  <- tcHsSigType (FunSigCtxt sel_name False) hs_sig_ty
                    ; let local_meth_ty = idType local_meth_id
+                         ctxt = FunSigCtxt sel_name False
+                                -- False <=> do not report redundant constraints when
+                                --           checking instance-sig <= class-meth-sig
+                                -- The instance-sig is the focus here; the class-meth-sig
+                                -- is fixed (#18036)
                    ; hs_wrap <- addErrCtxtM (methSigCtxt sel_name sig_ty local_meth_ty) $
                                 tcSubType_NC ctxt sig_ty local_meth_ty
                    ; return (sig_ty, hs_wrap) }
 
        ; inner_meth_name <- newName (nameOccName sel_name)
-       ; let inner_meth_id  = mkLocalId inner_meth_name sig_ty
+       ; let ctxt = FunSigCtxt sel_name True
+                    -- True <=> check for redundant constraints in the
+                    --          user-specified instance signature
+             inner_meth_id  = mkLocalId inner_meth_name sig_ty
              inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id
                                           , sig_ctxt = ctxt
                                           , sig_loc  = getLoc (hsSigType hs_sig_ty) }


=====================================
libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
=====================================
@@ -145,3 +145,7 @@ data Extension
    | CUSKs
    | StandaloneKindSignatures
    deriving (Eq, Enum, Show, Generic, Bounded)
+-- 'Ord' and 'Bounded' are provided for GHC API users (see discussions
+-- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and
+-- https://gitlab.haskell.org/ghc/ghc/merge_requests/826).
+instance Ord Extension where compare a b = compare (fromEnum a) (fromEnum b)


=====================================
testsuite/tests/typecheck/should_compile/T18036.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# OPTIONS_GHC -Wredundant-constraints #-}
+
+module T18036 where
+
+class Fold f where
+    fold :: Monoid m => f m -> m
+
+newtype Identity a = Identity a
+
+instance Fold Identity where
+    fold :: Identity a -> a
+    fold (Identity a) = a


=====================================
testsuite/tests/typecheck/should_compile/T18036a.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# OPTIONS_GHC -Wredundant-constraints #-}
+
+module T18036 where
+
+class Fold f where
+    fold :: Monoid m => f m -> m
+
+newtype Identity a = Identity a
+
+-- Here we /should/ warn about redundant constraints in the
+-- instance signature, since we can remove them
+instance Fold Identity where
+    fold :: Monoid a => Identity a -> a
+    fold (Identity a) = a


=====================================
testsuite/tests/typecheck/should_compile/T18036a.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T18036a.hs:14:13: warning: [-Wredundant-constraints]
+    • Redundant constraint: Monoid a
+    • In the type signature for:
+           fold :: forall a. Monoid a => Identity a -> a
+      In the instance declaration for ‘Fold Identity’


=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -703,3 +703,5 @@ test('T17024', normal, compile, [''])
 test('T17021a', normal, compile, [''])
 test('T18005', normal, compile, [''])
 test('T18023', normal, compile, [''])
+test('T18036', normal, compile, [''])
+test('T18036a', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b895317bff965a7f2aabc3bf83e118dff72b5fc0...72fbb1310056435e218e98c3f6875c93aa0a336d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b895317bff965a7f2aabc3bf83e118dff72b5fc0...72fbb1310056435e218e98c3f6875c93aa0a336d
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/20200419/0489fe06/attachment-0001.html>


More information about the ghc-commits mailing list