diff options
| author | fendor <power.walross@gmail.com> | 2020-05-22 15:15:15 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-01 06:36:18 -0400 |
| commit | 5ac4d94607d4a898f0015114e929ee9a38118985 (patch) | |
| tree | a38448634510ba0bbfe4f658ba51498c499f0405 | |
| parent | f3fb1ce9759d1ca57b9ea4acf5518df8d086688e (diff) | |
| download | haskell-5ac4d94607d4a898f0015114e929ee9a38118985.tar.gz | |
Lint rhs of IfaceRule
| -rw-r--r-- | compiler/GHC/IfaceToCore.hs | 23 |
1 files changed, 21 insertions, 2 deletions
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index d1e3bfa4bd..48652573f3 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -36,6 +36,7 @@ import GHC.Tc.Utils.TcType import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.Coercion.Axiom +import GHC.Core.FVs import GHC.Core.TyCo.Rep -- needs to build types & coercions in a knot import GHC.Core.TyCo.Subst ( substTyCoVars ) import GHC.Driver.Types @@ -1061,8 +1062,24 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd -- Typecheck the payload lazily, in the hope it'll never be looked at forkM (text "Rule" <+> pprRuleName name) $ bindIfaceBndrs bndrs $ \ bndrs' -> - do { args' <- mapM tcIfaceExpr args - ; rhs' <- tcIfaceExpr rhs + do { args' <- mapM tcIfaceExpr args + ; rhs' <- tcIfaceExpr rhs + ; whenGOptM Opt_DoCoreLinting $ do + { dflags <- getDynFlags + ; (_, lcl_env) <- getEnvs + ; let in_scope :: [Var] + in_scope = ((nonDetEltsUFM $ if_tv_env lcl_env) ++ + (nonDetEltsUFM $ if_id_env lcl_env) ++ + bndrs' ++ + exprsFreeIdsList args') + ; case lintExpr dflags in_scope rhs' of + Nothing -> return () + Just fail_msg -> do { mod <- getIfModule + ; pprPanic "Iface Lint failure" + (vcat [ text "In interface for" <+> ppr mod + , hang doc 2 fail_msg + , ppr name <+> equals <+> ppr rhs' + , text "Iface expr =" <+> ppr rhs ]) } } ; return (bndrs', args', rhs') } ; let mb_tcs = map ifTopFreeName args ; this_mod <- getIfModule @@ -1091,6 +1108,8 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd ifTopFreeName (IfaceExt n) = Just n ifTopFreeName _ = Nothing + doc = text "Unfolding of" <+> ppr name + {- ************************************************************************ * * |