From 257f1567395be441ebf7ada996e4edf36abbe7e9 Mon Sep 17 00:00:00 2001
From: Jaro Reinders <jaro.reinders@gmail.com>
Date: Mon, 17 Jul 2023 14:44:48 +0200
Subject: [PATCH] Add StgFromCore and StgCodeGen linting
---
compiler/GHC/Stg/Pipeline.hs | 3 +++
1 file changed, 3 insertions(+)
diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs
index c2bde7470a4f..587b9e30532e 100644
--- a/compiler/GHC/Stg/Pipeline.hs
+++ b/compiler/GHC/Stg/Pipeline.hs
@@ -74,6 +74,7 @@ stg2stg :: Logger
-> IO ([(CgStgTopBinding,IdSet)], StgCgInfos) -- output program
stg2stg logger extra_vars opts this_mod binds
= do { dump_when Opt_D_dump_stg_from_core "Initial STG:" binds
+ ; stg_linter False "StgFromCore" binds
; showPass logger "Stg2Stg"
-- Do the main business!
; binds' <- runStgM 'g' $
@@ -92,10 +93,12 @@ stg2stg logger extra_vars opts this_mod binds
; let (binds_sorted_with_fvs, imp_fvs) = unzip (depSortWithAnnotStgPgm this_mod binds')
-- See Note [Tag inference for interactive contexts]
; (cg_binds, cg_infos) <- inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs
+ ; stg_linter False "StgCodeGen" cg_binds
; pure (zip cg_binds imp_fvs, cg_infos)
}
where
+ stg_linter :: (BinderP a ~ Id, OutputablePass a) => Bool -> String -> [GenStgTopBinding a] -> IO ()
stg_linter unarised
| Just diag_opts <- stgPipeline_lint opts
= lintStgTopBindings
--
GitLab