Simon Peyton Jones pushed to branch wip/T26682 at Glasgow Haskell Compiler / GHC Commits: e7c025de by Simon Peyton Jones at 2025-12-30T00:06:27+00:00 Switch on debug tracing [skip ci] - - - - - 1 changed file: - compiler/GHC/Core/Opt/Specialise.hs Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -653,9 +653,7 @@ specProgram guts@(ModGuts { mg_module = this_mod -- Easiest thing is to do it all at once, as if all the top-level -- decls were mutually recursive ; let top_env = SE { se_subst = Core.mkEmptySubst $ - mkInScopeSetBndrs binds - -- mkInScopeSetList $ - -- bindersOfBinds binds + mkInScopeSetBndrs binds , se_module = this_mod , se_rules = rule_env , se_dflags = dflags } @@ -804,24 +802,24 @@ spec_imports :: SpecEnv -- Passed in so that all top-level Ids are in s , [CoreBind] ) -- Specialised bindings spec_imports env callers dict_binds calls = do { let import_calls = dVarEnvElts calls --- ; debugTraceMsg (text "specImports {" <+> --- vcat [ text "calls:" <+> ppr import_calls --- , text "dict_binds:" <+> ppr dict_binds ]) + ; debugTraceMsg (text "specImports {" <+> + vcat [ text "calls:" <+> ppr import_calls + , text "dict_binds:" <+> ppr dict_binds ]) ; (env, rules, spec_binds) <- go env import_calls --- ; debugTraceMsg (text "End specImports }" <+> ppr import_calls) --- + ; debugTraceMsg (text "End specImports }" <+> ppr import_calls) + ; return (env, rules, spec_binds) } where go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind]) go env [] = return (env, [], []) go env (cis : other_calls) = do { --- debugTraceMsg (text "specImport {" <+> vcat [ ppr cis --- , text "callers" <+> ppr callers --- , text "dict_binds" <+> ppr dict_binds ]) + debugTraceMsg (text "specImport {" <+> vcat [ ppr cis + , text "callers" <+> ppr callers + , text "dict_binds" <+> ppr dict_binds ]) ; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis --- ; debugTraceMsg (text "specImport }" <+> ppr cis) --- + ; debugTraceMsg (text "specImport }" <+> ppr cis) + ; (env, rules2, spec_binds2) <- go env other_calls ; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) } @@ -837,7 +835,7 @@ spec_import :: SpecEnv -- Passed in so that all top-level Ids are , [CoreBind] ) -- Specialised bindings spec_import env callers dict_binds cis@(CIS fn _) | isIn "specImport" fn callers - = do { -- debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers)) + = do { debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers)) ; return (env, [], []) } -- No warning. This actually happens all the time -- when specialising a recursive function, because @@ -845,7 +843,7 @@ spec_import env callers dict_binds cis@(CIS fn _) -- call to the original function | null good_calls - = do { -- debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds)) + = do { debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds)) ; return (env, [], []) } | Just rhs <- canSpecImport dflags fn @@ -855,12 +853,12 @@ spec_import env callers dict_binds cis@(CIS fn _) ; eps_rules <- getExternalRuleBase ; let rule_env = se_rules env `updExternalPackageRules` eps_rules --- ; debugTraceMsg (text "specImport1" <+> vcat --- [ text "function:" <+> ppr fn --- , text "good calls:" <+> ppr good_calls --- , text "existing rules:" <+> ppr (getRules rule_env fn) --- , text "rhs:" <+> ppr rhs --- , text "dict_binds:" <+> ppr dict_binds ]) + ; debugTraceMsg (text "specImport1" <+> vcat + [ text "function:" <+> ppr fn + , text "good calls:" <+> ppr good_calls + , text "existing rules:" <+> ppr (getRules rule_env fn) + , text "rhs:" <+> ppr rhs + , text "dict_binds:" <+> ppr dict_binds ]) ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls }) <- runSpecM $ specCalls True env (getRules rule_env fn) good_calls fn rhs @@ -877,12 +875,12 @@ spec_import env callers dict_binds cis@(CIS fn _) `bringFloatedDictsIntoScope` dict_binds1 -- Now specialise any cascaded calls --- ; debugTraceMsg (text "specImport 2" <+> vcat --- [ text "function:" <+> ppr fn --- , text "rules1:" <+> ppr rules1 --- , text "spec_binds1" <+> ppr spec_binds1 --- , text "dict_binds1" <+> ppr dict_binds1 --- , text "new_calls" <+> ppr new_calls ]) + ; debugTraceMsg (text "specImport 2" <+> vcat + [ text "function:" <+> ppr fn + , text "rules1:" <+> ppr rules1 + , text "spec_binds1" <+> ppr spec_binds1 + , text "dict_binds1" <+> ppr dict_binds1 + , text "new_calls" <+> ppr new_calls ]) ; (env, rules2, spec_binds2) <- spec_imports new_env (fn:callers) @@ -896,8 +894,8 @@ spec_import env callers dict_binds cis@(CIS fn _) | otherwise = do { --- debugTraceMsg (hang (text "specImport1-missed") --- 2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)])) + debugTraceMsg (hang (text "specImport1-missed") + 2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)])) ; tryWarnMissingSpecs dflags callers fn good_calls ; return (env, [], [])} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7c025dea9240cb76aebd4fc4072c7c8... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7c025dea9240cb76aebd4fc4072c7c8... You're receiving this email because of your account on gitlab.haskell.org.