diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-10-01 18:15:41 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-10-11 12:48:45 -0400 |
commit | fbb887406d27b5271e45392c2c25f8b1ba4cdeae (patch) | |
tree | cc4ca312a7a8c646fa99a21eb8c30b549de822af | |
parent | ed4b5885bdac7b986655bb40f8c9ece2f8735c98 (diff) | |
download | haskell-fbb887406d27b5271e45392c2c25f8b1ba4cdeae.tar.gz |
Tidy implicit binds
We want to put implicit binds into fat interface files, so the easiest
thing to do seems to be to treat them uniformly with other binders.
-rw-r--r-- | compiler/GHC/Iface/Tidy.hs | 15 | ||||
-rw-r--r-- | testsuite/tests/deSugar/should_compile/T2431.stderr | 7 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T7360.stderr | 1 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_compile/T16029.stdout | 4 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T14774.stdout | 1 |
5 files changed, 10 insertions, 18 deletions
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs index 68733b3671..1af2b99fc3 100644 --- a/compiler/GHC/Iface/Tidy.hs +++ b/compiler/GHC/Iface/Tidy.hs @@ -380,9 +380,10 @@ tidyProgram opts (ModGuts { mg_module = mod }) = do let implicit_binds = concatMap getImplicitBinds tcs + all_binds = implicit_binds ++ binds - (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod binds implicit_binds imp_rules - let (trimmed_binds, trimmed_rules) = findExternalRules opts binds imp_rules unfold_env + (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod all_binds imp_rules + let (trimmed_binds, trimmed_rules) = findExternalRules opts all_binds imp_rules unfold_env (tidy_env, tidy_binds) <- tidyTopBinds unfold_env boot_exports tidy_occ_env trimmed_binds @@ -419,7 +420,7 @@ tidyProgram opts (ModGuts { mg_module = mod tidy_rules = tidyRules tidy_env trimmed_rules -- See Note [Injecting implicit bindings] - all_tidy_binds = implicit_binds ++ tidy_binds' + all_tidy_binds = tidy_binds' -- Get the TyCons to generate code for. Careful! We must use -- the untidied TyCons here, because we need @@ -646,12 +647,11 @@ type UnfoldEnv = IdEnv (Name{-new name-}, Bool {-show unfolding-}) chooseExternalIds :: TidyOpts -> Module -> [CoreBind] - -> [CoreBind] -> [CoreRule] -> IO (UnfoldEnv, TidyOccEnv) -- Step 1 from the notes above -chooseExternalIds opts mod binds implicit_binds imp_id_rules +chooseExternalIds opts mod binds imp_id_rules = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders ; tidy_internal internal_ids unfold_env1 occ_env1 } @@ -680,10 +680,9 @@ chooseExternalIds opts mod binds implicit_binds imp_id_rules rule_rhs_vars = mapUnionVarSet ruleRhsFreeVars imp_id_rules binders = map fst $ flattenBinds binds - implicit_binders = bindersOfBinds implicit_binds binder_set = mkVarSet binders - avoids = [getOccName name | bndr <- binders ++ implicit_binders, + avoids = [getOccName name | bndr <- binders, let name = idName bndr, isExternalName name ] -- In computing our "avoids" list, we must include @@ -1010,7 +1009,7 @@ findExternalRules opts binds imp_id_rules unfold_env -- See Note [Which rules to expose] is_external_id id = case lookupVarEnv unfold_env id of - Just (name, _) -> isExternalName name + Just (name, _) -> isExternalName name && not (isImplicitId id) Nothing -> False trim_binds :: [CoreBind] diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index 3ff19d51ea..a60f023683 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -5,12 +5,7 @@ Result size of Tidy Core -- RHS size: {terms: 2, types: 3, coercions: 1, joins: 0/0} T2431.$WRefl [InlPrag=INLINE[final] CONLIKE] :: forall a. a :~: a -[GblId[DataConWrapper], - Caf=NoCafRefs, - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False) - Tmpl= \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a)}] +[GblId[DataConWrapper], Unf=OtherCon []] T2431.$WRefl = \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a) diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 17eb1b5934..4aaf784c63 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -7,7 +7,6 @@ Result size of Tidy Core T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo [GblId[DataConWrapper], Arity=1, - Caf=NoCafRefs, Str=<SL>, Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout index 20861eac28..6b5b6dcd91 100644 --- a/testsuite/tests/stranal/should_compile/T16029.stdout +++ b/testsuite/tests/stranal/should_compile/T16029.stdout @@ -1,7 +1,7 @@ :: Int %1 -> Int %1 -> T Tmpl= \ (conrep [Occ=Once1!] :: Int) - (conrep [Occ=Once1!] :: Int) -> - = \ (conrep [Occ=Once1!] :: Int) (conrep [Occ=Once1!] :: Int) -> + (conrep1 [Occ=Once1!] :: Int) -> + = \ (conrep [Occ=Once1!] :: Int) (conrep1 [Occ=Once1!] :: Int) -> :: GHC.Prim.Int# -> GHC.Prim.Int# = \ (ww :: GHC.Prim.Int#) -> g2 [InlPrag=[2]] :: T -> Int -> Int diff --git a/testsuite/tests/typecheck/should_compile/T14774.stdout b/testsuite/tests/typecheck/should_compile/T14774.stdout index f958cd8215..522c947b55 100644 --- a/testsuite/tests/typecheck/should_compile/T14774.stdout +++ b/testsuite/tests/typecheck/should_compile/T14774.stdout @@ -1,3 +1,2 @@ T14774.$p1D [InlPrag=[~]] :: forall a. D a => C a - RULES: Built in rule for T14774.$p1D: "Class op $p1D"] T14774.$p1D |