[Git][ghc/ghc][wip/move-warnDs] Move 'Useless SPECIALISE pragma' warnings to TcWarnings

[Sebastian Graf]

Sebastian Graf pushed to branch wip/move-warnDs at Glasgow Haskell Compiler / GHC


Commits:
99478003 by Sebastian Graf at 2019-06-16T09:52:50Z
Move 'Useless SPECIALISE pragma' warnings to TcWarnings

- - - - -


3 changed files:

- compiler/deSugar/DsBinds.hs
- compiler/typecheck/TcHsSyn.hs
- compiler/typecheck/TcWarnings.hs


Changes:

=====================================
compiler/deSugar/DsBinds.hs
=====================================
@@ -653,22 +653,6 @@ dsSpec :: Maybe CoreExpr        -- Just rhs => RULE is for a local binding
        -> Located TcSpecPrag
        -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))
 dsSpec mb_poly_rhs (dL->L loc (SpecPrag poly_id spec_co spec_inl))
-  | isJust (isClassOpId_maybe poly_id)
-  = putSrcSpanDs loc $
-    do { warnDs NoReason (text "Ignoring useless SPECIALISE pragma for class method selector"
-                          <+> quotes (ppr poly_id))
-       ; return Nothing  }  -- There is no point in trying to specialise a class op
-                            -- Moreover, classops don't (currently) have an inl_sat arity set
-                            -- (it would be Just 0) and that in turn makes makeCorePair bleat
-
-  | no_act_spec && isNeverActive rule_act
-  = putSrcSpanDs loc $
-    do { warnDs NoReason (text "Ignoring useless SPECIALISE pragma for NOINLINE function:"
-                          <+> quotes (ppr poly_id))
-       ; return Nothing  }  -- Function is NOINLINE, and the specialisation inherits that
-                            -- See Note [Activation pragmas for SPECIALISE]
-
-  | otherwise
   = putSrcSpanDs loc $
     do { uniq <- newUnique
        ; let poly_name = idName poly_id
@@ -746,6 +730,7 @@ dsSpec mb_poly_rhs (dL->L loc (SpecPrag poly_id spec_co spec_inl))
     -- See Note [Activation pragmas for SPECIALISE]
     -- no_act_spec is True if the user didn't write an explicit
     -- phase specification in the SPECIALISE pragma
+    -- Keep this in sync with 'TcWarnings.warnUnusedSpecialisePragma'
     no_act_spec = case inlinePragmaSpec spec_inl of
                     NoInline -> isNeverActive  spec_prag_act
                     _        -> isAlwaysActive spec_prag_act


=====================================
compiler/typecheck/TcHsSyn.hs
=====================================
@@ -682,7 +682,9 @@ zonkLTcSpecPrags env ps
   where
     zonk_prag (dL->L loc (SpecPrag id co_fn inl))
         = do { (_, co_fn') <- zonkCoFn env co_fn
-             ; return (cL loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) }
+             ; let prag = cL loc (SpecPrag (zonkIdOcc env id) co_fn' inl)
+             ; warnUselessSpecialisePragma prag
+             ; return prag }
 
 {-
 ************************************************************************


=====================================
compiler/typecheck/TcWarnings.hs
=====================================
@@ -9,7 +9,10 @@ module TcWarnings (
     warnAboutEmptyEnumerations,
 
     -- * Discarded do bindings
-    warnDiscardedDoBindings
+    warnDiscardedDoBindings,
+
+    -- * Useless pragmas
+    warnUselessSpecialisePragma
   ) where
 
 import GhcPrelude
@@ -274,3 +277,27 @@ badMonadBind rhs elt_ty
          , hang (text "Suppress this warning by saying")
               2 (quotes $ text "_ <-" <+> ppr rhs)
          ]
+
+warnUselessSpecialisePragma :: LTcSpecPrag -> TcM ()
+warnUselessSpecialisePragma (dL->L loc (SpecPrag id _ spec_inl))
+  | Just _ <- isClassOpId_maybe id
+  = setSrcSpan loc (warn_useless "class method selector")
+  | no_act_spec && isNeverActive id_rule_act
+  -- Function is NOINLINE, and the specialisation inherits that
+  -- See Note [Activation pragmas for SPECIALISE] in DsBinds
+  = setSrcSpan loc (warn_useless "NOINLINE function")
+  | otherwise
+  = return ()
+  where
+    warn_useless what = warnTc NoReason True $ hsep
+      [ text "Ignoring useless SPECIALISE pragma for"
+      , ppr what
+      , quotes (ppr id)
+      ]
+    -- See Note [Activation pragmas for SPECIALISE] in DsBinds
+    -- no_act_spec is True if the user didn't write an explicit
+    -- phase specification in the SPECIALISE pragma
+    no_act_spec = case inlinePragmaSpec spec_inl of
+                    NoInline -> isNeverActive  (inlinePragmaActivation spec_inl)
+                    _        -> isAlwaysActive (inlinePragmaActivation spec_inl)
+    id_rule_act = inlinePragmaActivation (idInlinePragma id)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/99478003846d35dd8c4401be90ce91f8a825fd59

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/99478003846d35dd8c4401be90ce91f8a825fd59
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/20190616/1d2d8978/attachment-0001.html>