
[Git][ghc/ghc][master] Revert "Specialise: Don't float out constraint components."
by Marge Bot (@marge-bot) 15 Jun '25
by Marge Bot (@marge-bot) 15 Jun '25
15 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c7aa0c10 by Andreas Klebinger at 2025-06-15T05:47:24-04:00
Revert "Specialise: Don't float out constraint components."
This reverts commit c9abb87ccc0c91cd94f42b3e36270158398326ef.
Turns out two benchmarks from #19747 regresses by a factor of 7-8x if
we do not float those out.
- - - - -
1 changed file:
- compiler/GHC/Core/Opt/Specialise.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -64,7 +64,7 @@ import GHC.Unit.Module.ModGuts
import GHC.Core.Unfold
import Data.List( partition )
--- import Data.List.NonEmpty ( NonEmpty (..) )
+import Data.List.NonEmpty ( NonEmpty (..) )
import GHC.Core.Subst (substTickish)
{-
@@ -1277,8 +1277,67 @@ specCase :: SpecEnv
, OutId
, [OutAlt]
, UsageDetails)
--- We used to float out super class selections here,
--- but no longer do so. See Historical Note [Floating dictionaries out of cases]
+specCase env scrut' case_bndr [Alt con args rhs]
+ | -- See Note [Floating dictionaries out of cases]
+ interestingDict scrut' (idType case_bndr)
+ , not (isDeadBinder case_bndr && null sc_args')
+ = do { case_bndr_flt :| sc_args_flt <- mapM clone_me (case_bndr' :| sc_args')
+
+ ; let case_bndr_flt' = case_bndr_flt `addDictUnfolding` scrut'
+ scrut_bind = mkDB (NonRec case_bndr_flt scrut')
+
+ sc_args_flt' = zipWith addDictUnfolding sc_args_flt sc_rhss
+ sc_rhss = [ Case (Var case_bndr_flt') case_bndr' (idType sc_arg')
+ [Alt con args' (Var sc_arg')]
+ | sc_arg' <- sc_args' ]
+ cb_set = unitVarSet case_bndr_flt'
+ sc_binds = [ DB { db_bind = NonRec sc_arg_flt sc_rhs, db_fvs = cb_set }
+ | (sc_arg_flt, sc_rhs) <- sc_args_flt' `zip` sc_rhss ]
+
+ flt_binds = scrut_bind : sc_binds
+
+ -- Extend the substitution for RHS to map the *original* binders
+ -- to their floated versions.
+ mb_sc_flts :: [Maybe DictId]
+ mb_sc_flts = map (lookupVarEnv clone_env) args'
+ clone_env = zipVarEnv sc_args' sc_args_flt'
+
+ subst_prs = (case_bndr, Var case_bndr_flt)
+ : [ (arg, Var sc_flt)
+ | (arg, Just sc_flt) <- args `zip` mb_sc_flts ]
+ subst' = se_subst env_rhs
+ `Core.extendSubstInScopeList` (case_bndr_flt' : sc_args_flt')
+ `Core.extendIdSubstList` subst_prs
+ env_rhs' = env_rhs { se_subst = subst' }
+
+ ; (rhs', rhs_uds) <- specExpr env_rhs' rhs
+ ; let (free_uds, dumped_dbs) = dumpUDs (case_bndr':args') rhs_uds
+ all_uds = flt_binds `consDictBinds` free_uds
+ alt' = Alt con args' (wrapDictBindsE dumped_dbs rhs')
+-- ; pprTrace "specCase" (ppr case_bndr $$ ppr scrut_bind) $
+ ; return (Var case_bndr_flt, case_bndr', [alt'], all_uds) }
+ where
+ (env_rhs, (case_bndr':|args')) = substBndrs env (case_bndr:|args)
+ sc_args' = filter is_flt_sc_arg args'
+
+ clone_me bndr = do { uniq <- getUniqueM
+ ; return (mkUserLocalOrCoVar occ uniq wght ty loc) }
+ where
+ name = idName bndr
+ wght = idMult bndr
+ ty = idType bndr
+ occ = nameOccName name
+ loc = getSrcSpan name
+
+ arg_set = mkVarSet args'
+ is_flt_sc_arg var = isId var
+ && not (isDeadBinder var)
+ && isDictTy var_ty
+ && tyCoVarsOfType var_ty `disjointVarSet` arg_set
+ where
+ var_ty = idType var
+
+
specCase env scrut case_bndr alts
= do { (alts', uds_alts) <- mapAndCombineSM spec_alt alts
; return (scrut, case_bndr', alts', uds_alts) }
@@ -1355,36 +1414,36 @@ Note [tryRules: plan (BEFORE)] in the Simplifier (partly) redundant. That is,
if we run rules in the specialiser, does it matter if we make rules "win" over
inlining in the Simplifier? Yes, it does! See the discussion in #21851.
-Historical Note [Floating dictionaries out of cases]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Function `specCase` used to give special treatment to a case-expression
-that scrutinised a dictionary, like this:
+Note [Floating dictionaries out of cases]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
g = \d. case d of { MkD sc ... -> ...(f sc)... }
-But actually
-
-* We never explicitly case-analyse a dictionary; rather the class-op
- rules select superclasses from it. (NB: worker/wrapper can unbox
- tuple dictionaries -- see (DNB1) in Note [Do not unbox class dictionaries];
- but that's only after worker/wrapper, and specialisation happens before
- that.)
-
-* Calling `interestingDict` on every scrutinee is hardly sensible;
- generally `interestingDict` is called only on Constraint-kinded things.
-
-* It was giving a Lint scope error in !14272
-
-So now there is no special case. This Note just records the change
-in case we ever want to reinstate it. The original note was
-added in
-
- commit c107a00ccf1e641a2d008939cf477c71caa028d5
- Author: Simon Peyton Jones <simonpj(a)microsoft.com>
- Date: Thu Aug 12 13:11:33 2010 +0000
-
- Improve the Specialiser, fixing Trac #4203
-
-End of Historical Note
-
+Naively we can't float d2's binding out of the case expression,
+because 'sc' is bound by the case, and that in turn means we can't
+specialise f, which seems a pity.
+
+So we invert the case, by floating out a binding
+for 'sc_flt' thus:
+ sc_flt = case d of { MkD sc ... -> sc }
+Now we can float the call instance for 'f'. Indeed this is just
+what'll happen if 'sc' was originally bound with a let binding,
+but case is more efficient, and necessary with equalities. So it's
+good to work with both.
+
+You might think that this won't make any difference, because the
+call instance will only get nuked by the \d. BUT if 'g' itself is
+specialised, then transitively we should be able to specialise f.
+
+In general, given
+ case e of cb { MkD sc ... -> ...(f sc)... }
+we transform to
+ let cb_flt = e
+ sc_flt = case cb_flt of { MkD sc ... -> sc }
+ in
+ case cb_flt of bg { MkD sc ... -> ....(f sc_flt)... }
+
+The "_flt" things are the floated binds; we use the current substitution
+to substitute sc -> sc_flt in the RHS
************************************************************************
* *
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7aa0c108fce9148eabc91bafbf04d8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7aa0c108fce9148eabc91bafbf04d8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Improve redundant constraints for instance decls
by Marge Bot (@marge-bot) 15 Jun '25
by Marge Bot (@marge-bot) 15 Jun '25
15 Jun '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
19f20861 by Simon Peyton Jones at 2025-06-13T09:51:11-04:00
Improve redundant constraints for instance decls
Addresses #25992, which showed that the default methods
of an instance decl could make GHC fail to report redundant
constraints.
Figuring out how to do this led me to refactor the computation
of redundant constraints. See the entirely rewritten
Note [Tracking redundant constraints]
in GHC.Tc.Solver.Solve
- - - - -
1d02798e by Matthew Pickering at 2025-06-13T09:51:54-04:00
Refactor the treatment of nested Template Haskell splices
* The difference between a normal splice, a quasiquoter and implicit
splice caused by lifting is stored in the AST after renaming.
* Information that the renamer learns about splices is stored in the
relevant splice extension points (XUntypedSpliceExpr, XQuasiQuote).
* Normal splices and quasi quotes record the flavour of splice
(exp/pat/dec etc)
* Implicit lifting stores information about why the lift was attempted,
so if it fails, that can be reported to the user.
* After renaming, the decision taken to attempt to implicitly lift a
variable is stored in the `XXUntypedSplice` extension field in the
`HsImplicitLiftSplice` constructor.
* Since all the information is stored in the AST, in `HsUntypedSplice`,
the type of `PendingRnSplice` now just stores a `HsUntypedSplice`.
* Error messages since the original program can be easily
printed, this is noticeable in the case of implicit lifting.
* The user-written syntax is directly type-checked. Before, some
desugaring took place in the
* Fixes .hie files to work better with nested splices (nested splices
are not indexed)
* The location of the quoter in a quasiquote is now located, so error
messages will precisely point to it (and again, it is indexed by hie
files)
In the future, the typechecked AST should also retain information about
the splices and the specific desugaring being left to the desugarer.
Also, `runRnSplice` should call `tcUntypedSplice`, otherwise the
typechecking logic is duplicated (see the `QQError` and `QQTopError`
tests for a difference caused by this).
- - - - -
f93798ba by Cheng Shao at 2025-06-13T09:52:35-04:00
libffi: update to 3.5.1
Bumps libffi submodule.
- - - - -
ff9bea63 by Andreas Klebinger at 2025-06-15T00:07:02-04:00
Revert "Specialise: Don't float out constraint components."
This reverts commit c9abb87ccc0c91cd94f42b3e36270158398326ef.
Turns out two benchmarks from #19747 regresses by a factor of 7-8x if
we do not float those out.
- - - - -
b4b48d5d by Krzysztof Gogolewski at 2025-06-15T00:07:03-04:00
Fix EPT enforcement when mixing unboxed tuples and non-tuples
The code was assuming that an alternative cannot be returning a normal
datacon and an unboxed tuple at the same time. However, as seen in #26107,
this can happen when using a GADT to refine the representation type.
The solution is just to conservatively return TagDunno.
- - - - -
65 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Stg/EnforceEpt/Types.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/TH.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/ThLevelIndex.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- libffi-tarballs
- testsuite/tests/dependent/should_fail/T13135_simple.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/linear/should_fail/LinearTHFail.stderr
- testsuite/tests/linters/notes.stdout
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/quasiquotation/T3953.stderr
- + testsuite/tests/quotes/QQError.hs
- + testsuite/tests/quotes/QQError.stderr
- testsuite/tests/quotes/T10384.stderr
- testsuite/tests/quotes/TH_localname.stderr
- testsuite/tests/quotes/all.T
- + testsuite/tests/rep-poly/T26107.hs
- testsuite/tests/rep-poly/all.T
- + testsuite/tests/th/QQInQuote.hs
- + testsuite/tests/th/QQTopError.hs
- + testsuite/tests/th/QQTopError.stderr
- testsuite/tests/th/T10598_TH.stderr
- testsuite/tests/th/T14681.stderr
- testsuite/tests/th/T17804.stderr
- testsuite/tests/th/T5508.stderr
- testsuite/tests/th/TH_Lift.stderr
- testsuite/tests/th/all.T
- testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
- + testsuite/tests/typecheck/should_compile/T25992.hs
- + testsuite/tests/typecheck/should_compile/T25992.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/tcfail097.stderr
- utils/check-exact/ExactPrint.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5a2f92be0985b8ee406afc45f03419…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5a2f92be0985b8ee406afc45f03419…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T26107] Fix EPT enforcement when mixing unboxed tuples and non-tuples
by Krzysztof Gogolewski (@monoidal) 15 Jun '25
by Krzysztof Gogolewski (@monoidal) 15 Jun '25
15 Jun '25
Krzysztof Gogolewski pushed to branch wip/T26107 at Glasgow Haskell Compiler / GHC
Commits:
f97431c9 by Krzysztof Gogolewski at 2025-06-15T02:01:07+02:00
Fix EPT enforcement when mixing unboxed tuples and non-tuples
The code was assuming that an alternative cannot be returning a normal
datacon and an unboxed tuple at the same time. However, as seen in #26107,
this can happen when using a GADT to refine the representation type.
The solution is just to conservatively return TagDunno.
- - - - -
3 changed files:
- compiler/GHC/Stg/EnforceEpt/Types.hs
- + testsuite/tests/rep-poly/T26107.hs
- testsuite/tests/rep-poly/all.T
Changes:
=====================================
compiler/GHC/Stg/EnforceEpt/Types.hs
=====================================
@@ -39,8 +39,8 @@ type InferStgAlt = GenStgAlt 'InferTaggedBinders
combineAltInfo :: TagInfo -> TagInfo -> TagInfo
combineAltInfo TagDunno _ = TagDunno
combineAltInfo _ TagDunno = TagDunno
-combineAltInfo (TagTuple {}) TagProper = panic "Combining unboxed tuple with non-tuple result"
-combineAltInfo TagProper (TagTuple {}) = panic "Combining unboxed tuple with non-tuple result"
+combineAltInfo (TagTuple {}) TagProper = TagDunno -- This can happen with rep-polymorphic result, see #26107
+combineAltInfo TagProper (TagTuple {}) = TagDunno -- This can happen with rep-polymorphic result, see #26107
combineAltInfo TagProper TagProper = TagProper
combineAltInfo (TagTuple is1) (TagTuple is2) = TagTuple (zipWithEqual combineAltInfo is1 is2)
combineAltInfo (TagTagged) ti = ti
=====================================
testsuite/tests/rep-poly/T26107.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs, UnboxedTuples #-}
+module T26107 where
+
+import Data.Kind
+import GHC.Exts
+
+type T :: TYPE rep -> Type
+data T a where
+ A :: T Bool
+ B :: T (# #)
+
+f :: forall rep (a :: TYPE rep). T a -> a
+f A = True
+f B = (# #)
=====================================
testsuite/tests/rep-poly/all.T
=====================================
@@ -41,6 +41,7 @@ test('T23883a', normal, compile_fail, [''])
test('T23883b', normal, compile_fail, [''])
test('T23883c', normal, compile_fail, [''])
test('T23903', normal, compile_fail, [''])
+test('T26107', js_broken(22364), compile, ['-O'])
test('EtaExpandDataCon', normal, compile, ['-O'])
test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f97431c9b0ea6edb2c62a23aa4d0447…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f97431c9b0ea6edb2c62a23aa4d0447…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/az/ghc-cpp] 141 commits: Hadrian: Add option to generate .hie files for stage1 libraries
by Alan Zimmerman (@alanz) 14 Jun '25
by Alan Zimmerman (@alanz) 14 Jun '25
14 Jun '25
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
35826d8b by Matthew Pickering at 2025-06-08T22:00:41+01:00
Hadrian: Add option to generate .hie files for stage1 libraries
The +hie_files flavour transformer can be enabled to produce hie files
for stage1 libraries. The hie files are produced in the
"extra-compilation-artifacts" folder and copied into the resulting
bindist.
At the moment the hie files are not produced for the release flavour,
they add about 170M to the final bindist.
Towards #16901
- - - - -
e2467dbd by Ryan Hendrickson at 2025-06-09T13:07:05-04:00
Fix various failures to -fprint-unicode-syntax
- - - - -
1d99d3e4 by maralorn at 2025-06-12T03:47:39-04:00
Add necessary flag for js linking
- - - - -
974d5734 by maralorn at 2025-06-12T03:47:39-04:00
Don’t use additional linker flags to detect presence of -fno-pie in configure.ac
This mirrors the behavior of ghc-toolchain
- - - - -
1e9eb118 by Andrew Lelechenko at 2025-06-12T03:48:21-04:00
Add HasCallStack to Control.Monad.Fail.fail
CLC proposal https://github.com/haskell/core-libraries-committee/issues/327
2% compile-time allocations increase in T3064, likely because `fail`
is now marginally more expensive to compile.
Metric Increase:
T3064
- - - - -
6d12060f by meooow25 at 2025-06-12T14:26:07-04:00
Bump containers submodule to 0.8
Also
* Disable -Wunused-imports for containers
* Allow containers-0.8 for in-tree packages
* Bump some submodules so that they allow containers-0.8. These are not
at any particular versions.
* Remove unused deps containers and split from ucd2haskell
* Fix tests affected by the new containers and hpc-bin
- - - - -
537bd233 by Peng Fan at 2025-06-12T14:27:02-04:00
NCG/LA64: Optimize code generation and reduce build-directory size.
1. makeFarBranches: Prioritize fewer instruction sequences.
2. Prefer instructions with immediate numbers to reduce register moves,
e.g. andi,ori,xori,addi.
3. Ppr: Remove unnecessary judgments.
4. genJump: Avoid "ld+jr" as much as possible.
5. BCOND and BCOND1: Implement conditional jumps with two jump ranges,
with limited choice of the shortest.
6. Implement FSQRT, CLT, CTZ.
7. Remove unnecessary code.
- - - - -
19f20861 by Simon Peyton Jones at 2025-06-13T09:51:11-04:00
Improve redundant constraints for instance decls
Addresses #25992, which showed that the default methods
of an instance decl could make GHC fail to report redundant
constraints.
Figuring out how to do this led me to refactor the computation
of redundant constraints. See the entirely rewritten
Note [Tracking redundant constraints]
in GHC.Tc.Solver.Solve
- - - - -
1d02798e by Matthew Pickering at 2025-06-13T09:51:54-04:00
Refactor the treatment of nested Template Haskell splices
* The difference between a normal splice, a quasiquoter and implicit
splice caused by lifting is stored in the AST after renaming.
* Information that the renamer learns about splices is stored in the
relevant splice extension points (XUntypedSpliceExpr, XQuasiQuote).
* Normal splices and quasi quotes record the flavour of splice
(exp/pat/dec etc)
* Implicit lifting stores information about why the lift was attempted,
so if it fails, that can be reported to the user.
* After renaming, the decision taken to attempt to implicitly lift a
variable is stored in the `XXUntypedSplice` extension field in the
`HsImplicitLiftSplice` constructor.
* Since all the information is stored in the AST, in `HsUntypedSplice`,
the type of `PendingRnSplice` now just stores a `HsUntypedSplice`.
* Error messages since the original program can be easily
printed, this is noticeable in the case of implicit lifting.
* The user-written syntax is directly type-checked. Before, some
desugaring took place in the
* Fixes .hie files to work better with nested splices (nested splices
are not indexed)
* The location of the quoter in a quasiquote is now located, so error
messages will precisely point to it (and again, it is indexed by hie
files)
In the future, the typechecked AST should also retain information about
the splices and the specific desugaring being left to the desugarer.
Also, `runRnSplice` should call `tcUntypedSplice`, otherwise the
typechecking logic is duplicated (see the `QQError` and `QQTopError`
tests for a difference caused by this).
- - - - -
f93798ba by Cheng Shao at 2025-06-13T09:52:35-04:00
libffi: update to 3.5.1
Bumps libffi submodule.
- - - - -
4c469768 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
GHC-CPP: first rough proof of concept
Processes
#define FOO
#ifdef FOO
x = 1
#endif
Into
[ITcppIgnored [L loc ITcppDefine]
,ITcppIgnored [L loc ITcppIfdef]
,ITvarid "x"
,ITequal
,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1})
,ITcppIgnored [L loc ITcppEndif]
,ITeof]
In time, ITcppIgnored will be pushed into a comment
- - - - -
94d52516 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Tidy up before re-visiting the continuation mechanic
- - - - -
db9f58c9 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Switch preprocessor to continuation passing style
Proof of concept, needs tidying up
- - - - -
8452c145 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Small cleanup
- - - - -
c6681522 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Get rid of some cruft
- - - - -
be02e288 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Starting to integrate.
Need to get the pragma recognised and set
- - - - -
65c23e60 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Make cppTokens extend to end of line, and process CPP comments
- - - - -
93508504 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Remove unused ITcppDefined
- - - - -
067d7ca8 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Allow spaces between # and keyword for preprocessor directive
- - - - -
a4545a17 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Process CPP continuation lines
They are emited as separate ITcppContinue tokens.
Perhaps the processing should be more like a comment, and keep on
going to the end.
BUT, the last line needs to be slurped as a whole.
- - - - -
321dc532 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Accumulate CPP continuations, process when ready
Can be simplified further, we only need one CPP token
- - - - -
31c636bb by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Simplify Lexer interface. Only ITcpp
We transfer directive lines through it, then parse them from scratch
in the preprocessor.
- - - - -
42f55a97 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Deal with directive on last line, with no trailing \n
- - - - -
37a58edf by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Start parsing and processing the directives
- - - - -
d8c030dd by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Prepare for processing include files
- - - - -
fff86bf5 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Move PpState into PreProcess
And initParserState, initPragState too
- - - - -
b38f1dcb by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Process nested include files
Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci
session, loading utils/check-cpp/Main.hs
- - - - -
6edae67e by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Split into separate files
- - - - -
b4a1c51a by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Starting on expression parser.
But it hangs. Time for Text.Parsec.Expr
- - - - -
466c4bbc by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Start integrating the ghc-cpp work
From https://github.com/alanz/ghc-cpp
- - - - -
54a33893 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
WIP
- - - - -
1ff0299c by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Fixup after rebase
- - - - -
091ccba3 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
WIP
- - - - -
e209e8a8 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Fixup after rebase, including all tests pass
- - - - -
15fc3813 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Change pragma usage to GHC_CPP from GhcCPP
- - - - -
7e9ab2d5 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Some comments
- - - - -
0f0afba2 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Reformat
- - - - -
4612b446 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Delete unused file
- - - - -
b8d1ded0 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Rename module Parse to ParsePP
- - - - -
7e0b984c by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Clarify naming in the parser
- - - - -
1142339c by Alan Zimmerman at 2025-06-14T09:55:42+01:00
WIP. Switching to alex/happy to be able to work in-tree
Since Parsec is not available
- - - - -
64485aeb by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Layering is now correct
- GHC lexer, emits CPP tokens
- accumulated in Preprocessor state
- Lexed by CPP lexer, CPP command extracted, tokens concated with
spaces (to get rid of token pasting via comments)
- if directive lexed and parsed by CPP lexer/parser, and evaluated
- - - - -
56e890df by Alan Zimmerman at 2025-06-14T09:55:42+01:00
First example working
Loading Example1.hs into ghci, getting the right results
```
{-# LANGUAGE GHC_CPP #-}
module Example1 where
y = 3
x =
"hello"
"bye now"
foo = putStrLn x
```
- - - - -
35571286 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
Rebase, and all tests pass except whitespace for generated parser
- - - - -
cd41e5e9 by Alan Zimmerman at 2025-06-14T09:55:42+01:00
More plumbing. Ready for testing tomorrow.
- - - - -
f546d56f by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Proress. Renamed module State from Types
And at first blush it seems to handle preprocessor scopes properly.
- - - - -
5c881727 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Insert basic GHC version macros into parser
__GLASGOW_HASKELL__
__GLASGOW_HASKELL_FULL_VERSION__
__GLASGOW_HASKELL_PATCHLEVEL1__
__GLASGOW_HASKELL_PATCHLEVEL2__
- - - - -
47d9fe5d by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Re-sync check-cpp for easy ghci work
- - - - -
307f1776 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Get rid of warnings
- - - - -
806d7a86 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Rework macro processing, in check-cpp
Macros kept at the top level, looked up via name, multiple arity
versions per name can be stored
- - - - -
7c4b6c1a by Alan Zimmerman at 2025-06-14T09:55:43+01:00
WIP. Can crack arguments for #define
Next step it to crack out args in an expansion
- - - - -
23184007 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
WIP on arg parsing.
- - - - -
464c61c1 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Progress. Still screwing up nested parens.
- - - - -
4f597fe8 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Seems to work, but has redundant code
- - - - -
4a95075a by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Remove redundant code
- - - - -
0991f54c by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Reformat
- - - - -
a0ed933e by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Expand args, single pass
Still need to repeat until fixpoint
- - - - -
1d065a9f by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Fixed point expansion
- - - - -
7973aa27 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Sync the playground to compiler
- - - - -
b7544bed by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Working on dumping the GHC_CPP result
But We need to keep the BufSpan in a comment
- - - - -
4e6aea58 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Keep BufSpan in queued comments in GHC.Parser.Lexer
- - - - -
046eef5a by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Getting close to being able to print the combined tokens
showing what is in and what is out
- - - - -
251ce408 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
First implementation of dumpGhcCpp.
Example output
First dumps all macros in the state, then the source, showing which
lines are in and which are out
------------------------------
- |#define FOO(A,B) A + B
- |#define FOO(A,B,C) A + B + C
- |#if FOO(1,FOO(3,4)) == 8
- |-- a comment
|x = 1
- |#else
- |x = 5
- |#endif
- - - - -
a04a6309 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Clean up a bit
- - - - -
9a57ae29 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Add -ddump-ghc-cpp option and a test based on it
- - - - -
abc294d4 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Restore Lexer.x rules, we need them for continuation lines
- - - - -
8f49326d by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Lexer.x: trying to sort out the span for continuations
- We need to match on \n at the end of the line
- We cannot simply back up for it
- - - - -
839a8f8a by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Inserts predefined macros. But does not dump properly
Because the cpp tokens have a trailing newline
- - - - -
c0abd96c by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Remove unnecessary LExer rules
We *need* the ones that explicitly match to the end of the line.
- - - - -
eaa655e0 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Generate correct span for ITcpp
Dump now works, except we do not render trailing `\` for continuation
lines. This is good enough for use in test output.
- - - - -
c3c8bdd9 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Reduce duplication in lexer
- - - - -
096e7337 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Tweaks
- - - - -
65963487 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Insert min_version predefined macros into state
The mechanism now works. Still need to flesh out the full set.
- - - - -
eb6d7b59 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Trying my alternative pragma syntax.
It works, but dumpGhcCpp is broken, I suspect from the ITcpp token
span update.
- - - - -
2e55b7cb by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Pragma extraction now works, with both CPP and GHC_CPP
For the following
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 913
{-# LANGUAGE GHC_CPP #-}
#endif
We will enable GHC_CPP only
- - - - -
3eb8b23a by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Remove some tracing
- - - - -
eced033c by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Fix test exes for changes
- - - - -
1c28d9fd by Alan Zimmerman at 2025-06-14T09:55:43+01:00
For GHC_CPP tests, normalise config-time-based macros
- - - - -
96f65347 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
WIP
- - - - -
2bfc662a by Alan Zimmerman at 2025-06-14T09:55:43+01:00
WIP again. What is wrong?
- - - - -
9cb0adf5 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Revert to dynflags for normal not pragma lexing
- - - - -
93dd5bec by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Working on getting check-exact to work properly
- - - - -
15e4b545 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Passes CppCommentPlacement test
- - - - -
0692562f by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Starting on exact printing with GHC_CPP
While overriding normal CPP
- - - - -
d8d49e42 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Correctly store CPP ignored tokens as comments
By populating the lexeme string in it, based on the bufpos
- - - - -
590c3120 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
WIP
- - - - -
f0726190 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Simplifying
- - - - -
7783f950 by Alan Zimmerman at 2025-06-14T09:55:43+01:00
Update the active state logic
- - - - -
a2690aca by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Work the new logic into the mainline code
- - - - -
611235f1 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Process `defined` operator
- - - - -
a1c5b380 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Manage lexer state while skipping tokens
There is very intricate layout-related state used when lexing. If a
CPP directive blanks out some tokens, store this state when the
blanking starts, and restore it when they are no longer being blanked.
- - - - -
ab4578bc by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Track the last token buffer index, for ITCppIgnored
We need to attach the source being skipped in an ITCppIgnored token.
We cannot simply use its BufSpan as an index into the underlying
StringBuffer as it counts unicode chars, not bytes.
So we update the lexer state to store the starting StringBuffer
location for the last token, and use the already-stored length to
extract the correct portion of the StringBuffer being parsed.
- - - - -
6104c6cd by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Process the ! operator in GHC_CPP expressions
- - - - -
63d74b11 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Predefine a constant when GHC_CPP is being used.
- - - - -
997cac00 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
WIP
- - - - -
70d3bbf3 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Skip lines directly in the lexer when required
- - - - -
81dfffbe by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Properly manage location when accepting tokens again
- - - - -
0da22464 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Seems to be working now, for Example9
- - - - -
5c3ad292 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Remove tracing
- - - - -
b507e7d0 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Fix parsing '*' in block comments
Instead of replacing them with '-'
- - - - -
2505f769 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Keep the trailing backslash in a ITcpp token
- - - - -
4756cef7 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Deal with only enabling one section of a group.
A group is an instance of a conditional introduced by
#if/#ifdef/#ifndef,
and ending at the final #endif, including intermediate #elsif sections
- - - - -
38b9960d by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Replace remaining identifiers with 0 when evaluating
As per the spec
- - - - -
de14ee97 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Snapshot before rebase
- - - - -
34a6b83e by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Skip non-processed lines starting with #
- - - - -
c452e5a3 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Export generateMacros so we can use it in ghc-exactprint
- - - - -
21f3185b by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Fix rebase
- - - - -
ff0864f0 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Expose initParserStateWithMacrosString
- - - - -
f8b5a1ff by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Fix buggy lexer cppSkip
It was skipping all lines, not just ones prefixed by #
- - - - -
638b98b2 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Fix evaluation of && to use the correct operator
- - - - -
ee94a6d0 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Deal with closing #-} at the start of a line
- - - - -
536a0848 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Add the MIN_VERSION_GLASGOW_HASKELL predefined macro
- - - - -
dae6a1b8 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr
- - - - -
7b35c213 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Use a strict map for macro defines
- - - - -
f440fa87 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Process TIdentifierLParen
Which only matters at the start of #define
- - - - -
5fad2fd7 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Do not provide TIdentifierLParen paren twice
- - - - -
67f74250 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Handle whitespace between identifier and '(' for directive only
- - - - -
efb87e66 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Expose some Lexer bitmap manipulation helpers
- - - - -
f1d37735 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Deal with line pragmas as tokens
Blows up for dumpGhcCpp though
- - - - -
43631633 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Allow strings delimited by a single quote too
- - - - -
598e6413 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Allow leading whitespace on cpp directives
As per https://timsong-cpp.github.io/cppwp/n4140/cpp#1
- - - - -
5ed12e21 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Implement GHC_CPP undef
- - - - -
c594922e by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Sort out expansion of no-arg macros, in a context with args
And make the expansion bottom out, in the case of recursion
- - - - -
7d5bec3c by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Fix GhcCpp01 test
The LINE pragma stuff works in ghc-exactprint when specifically
setting flag to emit ITline_pragma tokens
- - - - -
e71742fb by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Process comments in CPP directives
- - - - -
35005ddf by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Correctly lex pragmas with finel #-} on a newline
- - - - -
3c37dd74 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Do not process CPP-style comments
- - - - -
35a13235 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Allow cpp-style comments when GHC_CPP enabled
- - - - -
18e9be87 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Return other pragmas as cpp ignored when GHC_CPP active
- - - - -
48ed6cd4 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Fix exactprinting default decl
- - - - -
f1e043cd by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Reorganise getOptionsFromFile for use in ghc-exactprint
We want to be able to inject predefined macro definitions into the
parser preprocessor state for when we do a hackage roundtrip.
- - - - -
6d2efd77 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Tweak testing
- - - - -
9a8ae7bd by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Only allow unknown cpp pragmas with # in left margin
- - - - -
69d3b736 by Alan Zimmerman at 2025-06-14T09:55:44+01:00
Require # against left margin for all GHC_CPP directives
- - - - -
d7dd65cf by Alan Zimmerman at 2025-06-14T09:55:45+01:00
Fix CPP directives appearing in pragmas
And add a test for error reporting for missing `#if`
- - - - -
d70d9990 by Alan Zimmerman at 2025-06-14T09:55:45+01:00
Starting to report GHC_CPP errors using GHC machinery
- - - - -
686d8176 by Alan Zimmerman at 2025-06-14T09:55:45+01:00
More GHC_CPP diagnostic results
- - - - -
b1466814 by Alan Zimmerman at 2025-06-14T09:55:45+01:00
WIP on converting error calls to GHC diagnostics in GHC_CPP
- - - - -
ab80737b by Alan Zimmerman at 2025-06-14T09:55:45+01:00
Working on CPP diagnostic reporting
- - - - -
9c98015e by Alan Zimmerman at 2025-06-14T13:26:20+01:00
Tweak some tests/lint warnings
- - - - -
0d01124b by Alan Zimmerman at 2025-06-14T15:21:13+01:00
More error reporting in Macro
- - - - -
207 changed files:
- compiler/GHC.hs
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Cmm/Lexer.x
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Parser/Monad.hs
- compiler/GHC/CmmToAsm/LA64.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Parser.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Parser.hs-boot
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- + compiler/GHC/Parser/PreProcess.hs
- + compiler/GHC/Parser/PreProcess/Eval.hs
- + compiler/GHC/Parser/PreProcess/Lexer.x
- + compiler/GHC/Parser/PreProcess/Macro.hs
- + compiler/GHC/Parser/PreProcess/ParsePP.hs
- + compiler/GHC/Parser/PreProcess/Parser.y
- + compiler/GHC/Parser/PreProcess/ParserM.hs
- + compiler/GHC/Parser/PreProcess/State.hs
- compiler/GHC/Parser/Utils.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/TH.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/ThLevelIndex.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/ghc.cabal.in
- docs/users_guide/debugging.rst
- ghc/GHCi/UI.hs
- ghc/ghc-bin.cabal.in
- hadrian/doc/flavours.md
- hadrian/doc/user-settings.md
- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Context/Path.hs
- hadrian/src/Flavour.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Rules/SourceDist.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Release.hs
- hadrian/src/Settings/Warnings.hs
- hadrian/stack.yaml.lock
- libffi-tarballs
- libraries/base/changelog.md
- libraries/base/tests/IO/withBinaryFile002.stderr
- libraries/base/tests/IO/withFile002.stderr
- libraries/base/tests/IO/withFileBlocking002.stderr
- libraries/containers
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/tools/ucd2haskell/ucd2haskell.cabal
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- m4/fp_gcc_supports_no_pie.m4
- m4/fptools_set_c_ld_flags.m4
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_run/DsDoExprFailMsg.stderr
- testsuite/tests/deSugar/should_run/DsMonadCompFailMsg.stderr
- testsuite/tests/dependent/should_fail/T13135_simple.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/driver/T4437.hs
- testsuite/tests/ghc-api/T11579.hs
- + testsuite/tests/ghc-cpp/GhcCpp01.hs
- + testsuite/tests/ghc-cpp/GhcCpp01.stderr
- + testsuite/tests/ghc-cpp/GhcCpp02.hs
- + testsuite/tests/ghc-cpp/GhcCpp02.stderr
- + testsuite/tests/ghc-cpp/all.T
- testsuite/tests/ghci/scripts/T12550.stdout
- testsuite/tests/ghci/scripts/T8959b.stderr
- testsuite/tests/ghci/scripts/all.T
- + testsuite/tests/ghci/scripts/print-unicode-syntax.script
- + testsuite/tests/ghci/scripts/print-unicode-syntax.stderr
- + testsuite/tests/ghci/scripts/print-unicode-syntax.stdout
- testsuite/tests/ghci/should_run/T11825.stdout
- testsuite/tests/hpc/fork/hpc_fork.stdout
- testsuite/tests/hpc/function/tough.stdout
- testsuite/tests/hpc/function2/tough2.stdout
- testsuite/tests/hpc/simple/hpc001.stdout
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/linear/should_fail/LinearTHFail.stderr
- testsuite/tests/linters/notes.stdout
- testsuite/tests/partial-sigs/should_fail/T10999.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- + testsuite/tests/printer/CppCommentPlacement.hs
- testsuite/tests/quasiquotation/T3953.stderr
- + testsuite/tests/quotes/QQError.hs
- + testsuite/tests/quotes/QQError.stderr
- testsuite/tests/quotes/T10384.stderr
- testsuite/tests/quotes/TH_localname.stderr
- testsuite/tests/quotes/all.T
- testsuite/tests/rebindable/DoRestrictedM.hs
- + testsuite/tests/th/QQInQuote.hs
- + testsuite/tests/th/QQTopError.hs
- + testsuite/tests/th/QQTopError.stderr
- testsuite/tests/th/T10598_TH.stderr
- testsuite/tests/th/T14681.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/th/T17804.stderr
- testsuite/tests/th/T5508.stderr
- testsuite/tests/th/TH_Lift.stderr
- testsuite/tests/th/all.T
- testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
- + testsuite/tests/typecheck/should_compile/T25992.hs
- + testsuite/tests/typecheck/should_compile/T25992.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/tcfail097.stderr
- + utils/check-cpp/.ghci
- + utils/check-cpp/.gitignore
- + utils/check-cpp/Eval.hs
- + utils/check-cpp/Example1.hs
- + utils/check-cpp/Example10.hs
- + utils/check-cpp/Example11.hs
- + utils/check-cpp/Example12.hs
- + utils/check-cpp/Example13.hs
- + utils/check-cpp/Example2.hs
- + utils/check-cpp/Example3.hs
- + utils/check-cpp/Example4.hs
- + utils/check-cpp/Example5.hs
- + utils/check-cpp/Example6.hs
- + utils/check-cpp/Example7.hs
- + utils/check-cpp/Example8.hs
- + utils/check-cpp/Example9.hs
- + utils/check-cpp/Lexer.x
- + utils/check-cpp/Macro.hs
- + utils/check-cpp/Main.hs
- + utils/check-cpp/ParsePP.hs
- + utils/check-cpp/ParseSimulate.hs
- + utils/check-cpp/Parser.y
- + utils/check-cpp/ParserM.hs
- + utils/check-cpp/PreProcess.hs
- + utils/check-cpp/README.md
- + utils/check-cpp/State.hs
- + utils/check-cpp/run.sh
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Preprocess.hs
- utils/check-exact/Utils.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/hypsrc-test/ref/src/Quasiquoter.html
- utils/hpc
- utils/hsc2hs
- utils/iserv/iserv.cabal.in
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dbedd9273bbad78d40bb413a85c14a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dbedd9273bbad78d40bb413a85c14a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/az/ghc-cpp] Working on CPP diagnostic reporting
by Alan Zimmerman (@alanz) 14 Jun '25
by Alan Zimmerman (@alanz) 14 Jun '25
14 Jun '25
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
dbedd927 by Alan Zimmerman at 2025-06-14T09:51:38+01:00
Working on CPP diagnostic reporting
- - - - -
3 changed files:
- compiler/GHC/Parser/PreProcess/Macro.hs
- testsuite/tests/ghc-cpp/GhcCpp02.hs
- testsuite/tests/ghc-cpp/GhcCpp02.stderr
Changes:
=====================================
compiler/GHC/Parser/PreProcess/Macro.hs
=====================================
@@ -34,6 +34,7 @@ details
import Data.Map qualified as Map
import Data.Maybe
+import Data.List (intercalate)
import Data.Semigroup qualified as S
import GHC.Parser.PreProcess.Eval
@@ -74,7 +75,7 @@ expand loc s str = do
addGhcCPPError
loc
( hang
- (text "Error evaluating CPP condition1:") -- AZ:TODO remove 1
+ (text "Error evaluating CPP condition:")
2
(text err <+> text "of" $+$ text str)
)
@@ -88,7 +89,6 @@ maxExpansions = 15
expandToks :: SrcSpan -> Int -> MacroDefines -> [Token] -> PP [Token]
expandToks loc 0 _ ts = do
- -- error $ "macro_expansion limit (" ++ show maxExpansions ++ ") hit, aborting. ts=" ++ show ts
addGhcCPPError
loc
( hang
@@ -110,21 +110,35 @@ doExpandToks loc ed s (TIdentifierLParen n : ts) =
-- restore it to its constituent tokens
doExpandToks loc ed s (TIdentifier (init n) : TOpenParen "(" : ts)
doExpandToks loc _ s (TIdentifier "defined" : ts) = do
- let
- -- See Note: [defined unary operator] below
-
- rest = case getExpandArgs ts of
- (Just [[TIdentifier macro_name]], rest0) ->
- case Map.lookup macro_name s of
- Nothing -> TInteger "0" : rest0
- Just _ -> TInteger "1" : rest0
- (Nothing, TIdentifier macro_name : ts0) ->
- case Map.lookup macro_name s of
- Nothing -> TInteger "0" : ts0
- Just _ -> TInteger "1" : ts0
- (Nothing, _) -> error $ "defined: expected an identifier, got:" ++ show ts
- (Just args, _) -> error $ "defined: expected a single arg, got:" ++ show args
- return (True, rest)
+ -- See Note: ['defined' unary operator] below
+ case getExpandArgs ts of
+ (Just [[TIdentifier macro_name]], rest0) ->
+ case Map.lookup macro_name s of
+ Nothing -> return (True, TInteger "0" : rest0)
+ Just _ -> return (True, TInteger "1" : rest0)
+ (Nothing, TIdentifier macro_name : ts0) ->
+ case Map.lookup macro_name s of
+ Nothing -> return (True, TInteger "0" : ts0)
+ Just _ -> return (True, TInteger "1" : ts0)
+ (Nothing, _) -> do
+ addGhcCPPError
+ loc
+ ( hang
+ (text "CPP defined: expected an identifier, got:")
+ 2
+ (text (concatMap t_str ts))
+ )
+ return (False, [])
+ (Just args, _) -> do
+ -- error $ "defined: expected a single arg, got:" ++ show args
+ addGhcCPPError
+ loc
+ ( hang
+ (text "CPP defined: expected a single arg, got:")
+ 2
+ (text (intercalate "," (map (concatMap t_str) args)))
+ )
+ return (False, [])
doExpandToks loc ed s (TIdentifier n : ts) = do
let
(ed', expanded, ts') = case Map.lookup n s of
@@ -144,8 +158,8 @@ doExpandToks loc ed s (t : ts) = do
return (ed', t : r)
{-
-Note: [defined unary operator]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note: ['defined' unary operator]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
From https://timsong-cpp.github.io/cppwp/n4140/cpp#cond-1
=====================================
testsuite/tests/ghc-cpp/GhcCpp02.hs
=====================================
@@ -12,3 +12,14 @@ foo =
#if EXISTENT_MACRO(4)
bar = 3
#endif
+
+#define FOO(X) FOO(X)
+#if FOO(3)
+
+#endif
+
+#if defined 34
+#endif
+
+#if defined(A,B)
+#endif
=====================================
testsuite/tests/ghc-cpp/GhcCpp02.stderr
=====================================
@@ -7,3 +7,27 @@ GhcCpp02.hs:12:1: error: [GHC-93098]
Parse error at line 1, column 23 of
2 + NONEXISTENT_MACRO ( 4 )
+GhcCpp02.hs:17:1: error: [GHC-93098]
+ Error evaluating CPP condition:
+ Parse error at line 1, column 4 of
+ FOO( 3 )
+
+GhcCpp02.hs:17:1: error: [GHC-93098]
+ CPP macro expansion limit hit: FOO( 3 )
+
+GhcCpp02.hs:21:1: error: [GHC-93098]
+ Error evaluating CPP condition:
+ Parse error at line 1, column 0 of
+
+
+GhcCpp02.hs:21:1: error: [GHC-93098]
+ CPP defined: expected an identifier, got: 34
+
+GhcCpp02.hs:24:1: error: [GHC-93098]
+ Error evaluating CPP condition:
+ Parse error at line 1, column 0 of
+
+
+GhcCpp02.hs:24:1: error: [GHC-93098]
+ CPP defined: expected a single arg, got: A,B
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbedd9273bbad78d40bb413a85c14a9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbedd9273bbad78d40bb413a85c14a9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T26115] 15 commits: Bump containers submodule to 0.8
by Simon Peyton Jones (@simonpj) 14 Jun '25
by Simon Peyton Jones (@simonpj) 14 Jun '25
14 Jun '25
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
6d12060f by meooow25 at 2025-06-12T14:26:07-04:00
Bump containers submodule to 0.8
Also
* Disable -Wunused-imports for containers
* Allow containers-0.8 for in-tree packages
* Bump some submodules so that they allow containers-0.8. These are not
at any particular versions.
* Remove unused deps containers and split from ucd2haskell
* Fix tests affected by the new containers and hpc-bin
- - - - -
537bd233 by Peng Fan at 2025-06-12T14:27:02-04:00
NCG/LA64: Optimize code generation and reduce build-directory size.
1. makeFarBranches: Prioritize fewer instruction sequences.
2. Prefer instructions with immediate numbers to reduce register moves,
e.g. andi,ori,xori,addi.
3. Ppr: Remove unnecessary judgments.
4. genJump: Avoid "ld+jr" as much as possible.
5. BCOND and BCOND1: Implement conditional jumps with two jump ranges,
with limited choice of the shortest.
6. Implement FSQRT, CLT, CTZ.
7. Remove unnecessary code.
- - - - -
19f20861 by Simon Peyton Jones at 2025-06-13T09:51:11-04:00
Improve redundant constraints for instance decls
Addresses #25992, which showed that the default methods
of an instance decl could make GHC fail to report redundant
constraints.
Figuring out how to do this led me to refactor the computation
of redundant constraints. See the entirely rewritten
Note [Tracking redundant constraints]
in GHC.Tc.Solver.Solve
- - - - -
1d02798e by Matthew Pickering at 2025-06-13T09:51:54-04:00
Refactor the treatment of nested Template Haskell splices
* The difference between a normal splice, a quasiquoter and implicit
splice caused by lifting is stored in the AST after renaming.
* Information that the renamer learns about splices is stored in the
relevant splice extension points (XUntypedSpliceExpr, XQuasiQuote).
* Normal splices and quasi quotes record the flavour of splice
(exp/pat/dec etc)
* Implicit lifting stores information about why the lift was attempted,
so if it fails, that can be reported to the user.
* After renaming, the decision taken to attempt to implicitly lift a
variable is stored in the `XXUntypedSplice` extension field in the
`HsImplicitLiftSplice` constructor.
* Since all the information is stored in the AST, in `HsUntypedSplice`,
the type of `PendingRnSplice` now just stores a `HsUntypedSplice`.
* Error messages since the original program can be easily
printed, this is noticeable in the case of implicit lifting.
* The user-written syntax is directly type-checked. Before, some
desugaring took place in the
* Fixes .hie files to work better with nested splices (nested splices
are not indexed)
* The location of the quoter in a quasiquote is now located, so error
messages will precisely point to it (and again, it is indexed by hie
files)
In the future, the typechecked AST should also retain information about
the splices and the specific desugaring being left to the desugarer.
Also, `runRnSplice` should call `tcUntypedSplice`, otherwise the
typechecking logic is duplicated (see the `QQError` and `QQTopError`
tests for a difference caused by this).
- - - - -
f93798ba by Cheng Shao at 2025-06-13T09:52:35-04:00
libffi: update to 3.5.1
Bumps libffi submodule.
- - - - -
c4f8250e by Simon Peyton Jones at 2025-06-13T23:38:49+01:00
Renaming around predicate types
.. we were (as it turned out) abstracting over
type-class selectors in SPECIALISATION rules!
Wibble isEqPred
- - - - -
5eddea74 by Simon Peyton Jones at 2025-06-13T23:40:08+01:00
This increment adds tryTcS to support shortCutSolver
* Make short-cut solver invoke the real solver, so that it works
for type families.
* Use the short-cut solver for quantified constraints too.
* Use prepareSpecLHS for the old route too. Leave decomposeRuleLhs
for RULES only.
- - - - -
ea39c9e9 by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
wibbles
- - - - -
bd760673 by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
Wibble imports
- - - - -
c59b8cf9 by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
Refactor for Specialise.hs [skip ci]
- - - - -
833fed2d by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
More
- - - - -
6dc9a307 by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
More wibbles
- - - - -
37123721 by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
Add debug call-stacks
- - - - -
bef83be0 by Simon Peyton Jones at 2025-06-13T23:40:25+01:00
More wibbles
- - - - -
a1c855b4 by Simon Peyton Jones at 2025-06-14T01:16:46+01:00
Wibble
- - - - -
106 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/CmmToAsm/LA64.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Solver/Solve.hs
- + compiler/GHC/Tc/Solver/Solve.hs-boot
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/TH.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/ThLevelIndex.hs
- compiler/GHC/Types/Var.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/ghc.cabal.in
- ghc/ghc-bin.cabal.in
- hadrian/hadrian.cabal
- hadrian/src/Settings/Warnings.hs
- libffi-tarballs
- libraries/containers
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-internal/tools/ucd2haskell/ucd2haskell.cabal
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- testsuite/tests/dependent/should_fail/T13135_simple.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/hpc/fork/hpc_fork.stdout
- testsuite/tests/hpc/function/tough.stdout
- testsuite/tests/hpc/function2/tough2.stdout
- testsuite/tests/hpc/simple/hpc001.stdout
- testsuite/tests/linear/should_fail/LinearTHFail.stderr
- testsuite/tests/linters/notes.stdout
- testsuite/tests/partial-sigs/should_fail/T10999.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/quasiquotation/T3953.stderr
- + testsuite/tests/quotes/QQError.hs
- + testsuite/tests/quotes/QQError.stderr
- testsuite/tests/quotes/T10384.stderr
- testsuite/tests/quotes/TH_localname.stderr
- testsuite/tests/quotes/all.T
- testsuite/tests/rebindable/DoRestrictedM.hs
- + testsuite/tests/th/QQInQuote.hs
- + testsuite/tests/th/QQTopError.hs
- + testsuite/tests/th/QQTopError.stderr
- testsuite/tests/th/T10598_TH.stderr
- testsuite/tests/th/T14681.stderr
- testsuite/tests/th/T17804.stderr
- testsuite/tests/th/T5508.stderr
- testsuite/tests/th/TH_Lift.stderr
- testsuite/tests/th/all.T
- testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
- + testsuite/tests/typecheck/should_compile/T25992.hs
- + testsuite/tests/typecheck/should_compile/T25992.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/tcfail097.stderr
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/hpc
- utils/hsc2hs
- utils/iserv/iserv.cabal.in
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3405e84ed1b7d4afd30b577c38b2bb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3405e84ed1b7d4afd30b577c38b2bb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Cheng Shao pushed new branch wip/fix-ar at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-ar
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/module_graph_mode] Move ModuleGraph into UnitEnv
by Rodrigo Mesquita (@alt-romes) 13 Jun '25
by Rodrigo Mesquita (@alt-romes) 13 Jun '25
13 Jun '25
Rodrigo Mesquita pushed to branch wip/module_graph_mode at Glasgow Haskell Compiler / GHC
Commits:
a27803fa by Matthew Pickering at 2025-06-13T20:14:56+01:00
Move ModuleGraph into UnitEnv
The ModuleGraph is a piece of information associated with the
ExternalPackageState and HomeUnitGraph. Therefore we should store it
inside the HomeUnitEnv.
- - - - -
12 changed files:
- compiler/GHC.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Unit/Env.hs
- ghc/GHCi/UI.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -859,6 +859,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
, ue_namever = ghcNameVersion dflags1
, ue_home_unit_graph = home_unit_graph
, ue_current_unit = ue_currentUnit old_unit_env
+ , ue_module_graph = ue_module_graph old_unit_env
, ue_eps = ue_eps old_unit_env
}
modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env }
@@ -916,6 +917,7 @@ setProgramHUG_ invalidate_needed new_hug0 = do
, ue_home_unit_graph = home_unit_graph
, ue_current_unit = ue_currentUnit unit_env0
, ue_eps = ue_eps unit_env0
+ , ue_module_graph = ue_module_graph unit_env0
}
modifySession $ \h ->
-- hscSetFlags takes care of updating the logger as well.
@@ -996,7 +998,7 @@ setProgramHUG_ invalidate_needed new_hug0 = do
--
invalidateModSummaryCache :: GhcMonad m => m ()
invalidateModSummaryCache =
- modifySession $ \h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) }
+ modifySession $ \hsc_env -> setModuleGraph (mapMG inval (hsc_mod_graph hsc_env)) hsc_env
where
inval ms = ms { ms_hs_hash = fingerprint0 }
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -97,10 +97,11 @@ core2core hsc_env guts@(ModGuts { mg_module = mod
where
dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
+ unit_env = hsc_unit_env hsc_env
extra_vars = interactiveInScope (hsc_IC hsc_env)
home_pkg_rules = hugRulesBelow hsc_env (moduleUnitId mod)
(GWIB { gwib_mod = moduleName mod, gwib_isBoot = NotBoot })
- name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env
+ name_ppr_ctx = mkNamePprCtx ptc unit_env rdr_env
ptc = initPromotionTickContext dflags
-- mod: get the module out of the current HscEnv so we can retrieve it from the monad.
-- This is very convienent for the users of the monad (e.g. plugins do not have to
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -457,6 +457,7 @@ addUnit u = do
(homeUnitId home_unit)
(HUG.mkHomeUnitEnv unit_state (Just dbs) dflags (ue_hpt old_unit_env) (Just home_unit))
, ue_eps = ue_eps old_unit_env
+ , ue_module_graph = ue_module_graph old_unit_env
}
setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env }
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -2,6 +2,8 @@
module GHC.Driver.Env
( Hsc(..)
, HscEnv (..)
+ , hsc_mod_graph
+ , setModuleGraph
, hscUpdateFlags
, hscSetFlags
, hsc_home_unit
@@ -130,6 +132,9 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env
hsc_HUG :: HscEnv -> HomeUnitGraph
hsc_HUG = ue_home_unit_graph . hsc_unit_env
+hsc_mod_graph :: HscEnv -> ModuleGraph
+hsc_mod_graph = ue_module_graph . hsc_unit_env
+
hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId
hsc_all_home_unit_ids = HUG.allUnits . hsc_HUG
@@ -139,6 +144,9 @@ hscInsertHPT hmi hsc_env = UnitEnv.insertHpt hmi (hsc_unit_env hsc_env)
hscUpdateHUG :: (HomeUnitGraph -> HomeUnitGraph) -> HscEnv -> HscEnv
hscUpdateHUG f hsc_env = hsc_env { hsc_unit_env = updateHug f (hsc_unit_env hsc_env) }
+setModuleGraph :: ModuleGraph -> HscEnv -> HscEnv
+setModuleGraph mod_graph hsc_env = hsc_env { hsc_unit_env = (hsc_unit_env hsc_env) { ue_module_graph = mod_graph } }
+
{-
Note [Target code interpreter]
@@ -220,15 +228,15 @@ hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env)))
-- | Find all rules in modules that are in the transitive closure of the given
-- module.
hugRulesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO RuleBase
-hugRulesBelow hsc uid mn = foldr (flip extendRuleBaseList) emptyRuleBase <$>
- hugSomeThingsBelowUs (md_rules . hm_details) False hsc uid mn
+hugRulesBelow hsc_env uid mn = foldr (flip extendRuleBaseList) emptyRuleBase <$>
+ hugSomeThingsBelowUs (md_rules . hm_details) False hsc_env uid mn
-- | Get annotations from all modules "below" this one (in the dependency
-- sense) within the home units. If the module is @Nothing@, returns /all/
-- annotations in the home units.
hugAnnsBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO AnnEnv
-hugAnnsBelow hsc uid mn = foldr (flip extendAnnEnvList) emptyAnnEnv <$>
- hugSomeThingsBelowUs (md_anns . hm_details) False hsc uid mn
+hugAnnsBelow hsc_env uid mn = foldr (flip extendAnnEnvList) emptyAnnEnv <$>
+ hugSomeThingsBelowUs (md_anns . hm_details) False hsc_env uid mn
-- | Find all COMPLETE pragmas in modules that are in the transitive closure of the
-- given module.
@@ -260,7 +268,8 @@ hugInstancesBelow hsc_env uid mnwib = do
hugSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO [[a]]
-- An explicit check to see if we are in one-shot mode to avoid poking the ModuleGraph thunk
-- These things are currently stored in the EPS for home packages. (See #25795 for
--- progress in removing these kind of checks)
+-- progress in removing these kind of checks; and making these functions of
+-- `UnitEnv` rather than `HscEnv`)
-- See Note [Downsweep and the ModuleGraph]
hugSomeThingsBelowUs _ _ hsc_env _ _ | isOneShot (ghcMode (hsc_dflags hsc_env)) = return []
hugSomeThingsBelowUs extract include_hi_boot hsc_env uid mn
=====================================
compiler/GHC/Driver/Env/Types.hs
=====================================
@@ -18,7 +18,6 @@ import GHC.Types.Name.Cache
import GHC.Types.Target
import GHC.Types.TypeEnv
import GHC.Unit.Finder.Types
-import GHC.Unit.Module.Graph
import GHC.Unit.Env
import GHC.Utils.Logger
import GHC.Utils.TmpFs
@@ -65,10 +64,6 @@ data HscEnv
hsc_targets :: [Target],
-- ^ The targets (or roots) of the current session
- hsc_mod_graph :: ModuleGraph,
- -- ^ The module graph of the current session
- -- See Note [Downsweep and the ModuleGraph] for when this is constructed.
-
hsc_IC :: InteractiveContext,
-- ^ The context for evaluating interactive statements
@@ -113,3 +108,4 @@ data HscEnv
, hsc_llvm_config :: !LlvmConfigCache
-- ^ LLVM configuration cache.
}
+
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -332,7 +332,6 @@ newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do
return HscEnv { hsc_dflags = top_dynflags
, hsc_logger = setLogFlags logger (initLogFlags top_dynflags)
, hsc_targets = []
- , hsc_mod_graph = emptyMG
, hsc_IC = emptyInteractiveContext dflags
, hsc_NC = nc_var
, hsc_FC = fc_var
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -190,12 +190,12 @@ depanalE diag_wrapper msg excluded_mods allow_dup_roots = do
all_errs <- liftIO $ HUG.unitEnv_foldWithKey one_unit_messages (return emptyMessages) (hsc_HUG hsc_env)
logDiagnostics (GhcDriverMessage <$> all_errs)
- setSession hsc_env { hsc_mod_graph = mod_graph }
+ setSession (setModuleGraph mod_graph hsc_env)
pure (emptyMessages, mod_graph)
else do
-- We don't have a complete module dependency graph,
-- The graph may be disconnected and is unusable.
- setSession hsc_env { hsc_mod_graph = emptyMG }
+ setSession (setModuleGraph emptyMG hsc_env)
pure (errs, emptyMG)
@@ -616,7 +616,7 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
-- for any client who might interact with GHC via load'.
-- See Note [Timing of plugin initialization]
initializeSessionPlugins
- modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph }
+ modifySession (setModuleGraph mod_graph)
guessOutputFile
hsc_env <- getSession
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -768,8 +768,9 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
-- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.
-- See also Note [hsc_type_env_var hack]
type_env_var <- newIORef emptyNameEnv
- let hsc_env' = hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)])
- , hsc_mod_graph = mg }
+ let hsc_env' =
+ setModuleGraph mg
+ hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) }
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -671,7 +671,7 @@ dontLeakTheHUG thing_inside = do
-- oneshot mode does not support backpack
-- and we want to avoid prodding the hsc_mod_graph thunk
| isOneShot (ghcMode (hsc_dflags hsc_env)) = False
- | mgHasHoles (hsc_mod_graph hsc_env) = True
+ | mgHasHoles (ue_module_graph old_unit_env) = True
| otherwise = False
pruneHomeUnitEnv hme = do
-- NB: These are empty HPTs because Iface/Load first consults the HPT
@@ -683,19 +683,19 @@ dontLeakTheHUG thing_inside = do
| otherwise
= do
hug' <- traverse pruneHomeUnitEnv (ue_home_unit_graph old_unit_env)
+ let !new_mod_graph = emptyMG { mg_mss = panic "cleanTopEnv: mg_mss"
+ , mg_graph = panic "cleanTopEnv: mg_graph"
+ , mg_has_holes = keepFor20509 }
return old_unit_env
{ ue_home_unit_graph = hug'
+ , ue_module_graph = new_mod_graph
}
in do
!unit_env <- unit_env_io
-- mg_has_holes will be checked again, but nothing else about the module graph
- let !new_mod_graph = emptyMG { mg_mss = panic "cleanTopEnv: mg_mss"
- , mg_graph = panic "cleanTopEnv: mg_graph"
- , mg_has_holes = keepFor20509 }
pure $
hsc_env
{ hsc_targets = panic "cleanTopEnv: hsc_targets"
- , hsc_mod_graph = new_mod_graph
, hsc_IC = panic "cleanTopEnv: hsc_IC"
, hsc_type_env_vars = case maybe_type_vars of
Just vars -> vars
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -2109,7 +2109,7 @@ for the unit portion of the graph, if it's not already been performed.
withInteractiveModuleNode :: HscEnv -> TcM a -> TcM a
withInteractiveModuleNode hsc_env thing_inside = do
mg <- liftIO $ downsweepInteractiveImports hsc_env (hsc_IC hsc_env)
- updTopEnv (\env -> env { hsc_mod_graph = mg }) thing_inside
+ updTopEnv (setModuleGraph mg) thing_inside
runTcInteractive :: HscEnv -> TcRn a -> IO (Messages TcRnMessage, Maybe a)
=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -23,21 +23,22 @@
-- ┌▽────────────┐ │ │
-- │HomeUnitGraph│ │ │
-- └┬────────────┘ │ │
--- ┌▽─────────────────▽┐ │
--- │UnitEnv │ │
--- └┬──────────────────┘ │
--- ┌▽───────────────────────────────────────▽┐
--- │HscEnv │
--- └─────────────────────────────────────────┘
+-- ┌▽─────────────────▽─────────────────────▽┐
+-- │UnitEnv │
+-- └┬─────────────-──────────────────────────┘
+-- │
+-- │
+-- ┌▽──────────────────────────────────────▽┐
+-- │HscEnv │
+-- └────────────────────────────────────────┘
-- @
--
--- The 'UnitEnv' references both the 'HomeUnitGraph' (with all the home unit
--- modules) and the 'ExternalPackageState' (information about all
--- non-home/external units). The 'HscEnv' references this 'UnitEnv' and the
--- 'ModuleGraph' (which describes the relationship between the modules being
--- compiled). The 'HomeUnitGraph' has one 'HomePackageTable' for every unit.
---
--- TODO: Arguably, the 'ModuleGraph' should be part of 'UnitEnv' rather than being in the 'HscEnv'.
+-- The 'UnitEnv' references the 'HomeUnitGraph' (with all the home unit
+-- modules), the 'ExternalPackageState' (information about all
+-- non-home/external units), and the 'ModuleGraph' (which describes the
+-- relationship between the modules being compiled).
+-- The 'HscEnv' references this 'UnitEnv'.
+-- The 'HomeUnitGraph' has one 'HomePackageTable' for every unit.
module GHC.Unit.Env
( UnitEnv (..)
, initUnitEnv
@@ -119,6 +120,7 @@ import GHC.Unit.Home.ModInfo
import GHC.Unit.Home.PackageTable
import GHC.Unit.Home.Graph (HomeUnitGraph, HomeUnitEnv)
import qualified GHC.Unit.Home.Graph as HUG
+import GHC.Unit.Module.Graph
import GHC.Platform
import GHC.Settings
@@ -163,6 +165,10 @@ data UnitEnv = UnitEnv
, ue_current_unit :: UnitId
+ , ue_module_graph :: !ModuleGraph
+ -- ^ The module graph of the current session
+ -- See Note [Downsweep and the ModuleGraph] for when this is constructed.
+
, ue_home_unit_graph :: !HomeUnitGraph
-- See Note [Multiple Home Units]
@@ -182,6 +188,7 @@ initUnitEnv cur_unit hug namever platform = do
return $ UnitEnv
{ ue_eps = eps
, ue_home_unit_graph = hug
+ , ue_module_graph = emptyMG
, ue_current_unit = cur_unit
, ue_platform = platform
, ue_namever = namever
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -4680,7 +4680,7 @@ clearHPTs = do
let pruneHomeUnitEnv hme = liftIO $ do
emptyHpt <- emptyHomePackageTable
pure hme{ homeUnitEnv_hpt = emptyHpt }
- discardMG hsc = hsc { hsc_mod_graph = GHC.emptyMG }
+ discardMG hsc = setModuleGraph GHC.emptyMG hsc
modifySessionM $ \hsc_env -> do
hug' <- traverse pruneHomeUnitEnv $ hsc_HUG hsc_env
pure $ discardMG $ discardIC $ hscUpdateHUG (const hug') hsc_env
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a27803fa7ab18582f61558aaf3799d9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a27803fa7ab18582f61558aaf3799d9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T26118-remove-hptallfaminstances-usage-during-upsweep] Remove unused hptAllFamInstances and allFamInstances functions
by Patrick (@soulomoon) 13 Jun '25
by Patrick (@soulomoon) 13 Jun '25
13 Jun '25
Patrick pushed to branch wip/T26118-remove-hptallfaminstances-usage-during-upsweep at Glasgow Haskell Compiler / GHC
Commits:
c589f636 by soulomoon at 2025-06-14T01:32:16+08:00
Remove unused hptAllFamInstances and allFamInstances functions
- - - - -
2 changed files:
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Home/PackageTable.hs
Changes:
=====================================
compiler/GHC/Unit/Home/Graph.hs
=====================================
@@ -43,7 +43,6 @@ module GHC.Unit.Home.Graph
-- * Very important queries
, allInstances
- , allFamInstances
, allAnns
, allCompleteSigs
@@ -110,10 +109,6 @@ allInstances hug = foldr go (pure (emptyInstEnv, [])) hug where
go hue = liftA2 (\(a,b) (a',b') -> (a `unionInstEnv` a', b ++ b'))
(hptAllInstances (homeUnitEnv_hpt hue))
-allFamInstances :: HomeUnitGraph -> IO (ModuleEnv FamInstEnv)
-allFamInstances hug = foldr go (pure emptyModuleEnv) hug where
- go hue = liftA2 plusModuleEnv (hptAllFamInstances (homeUnitEnv_hpt hue))
-
allAnns :: HomeUnitGraph -> IO AnnEnv
allAnns hug = foldr go (pure emptyAnnEnv) hug where
go hue = liftA2 plusAnnEnv (hptAllAnnotations (homeUnitEnv_hpt hue))
=====================================
compiler/GHC/Unit/Home/PackageTable.hs
=====================================
@@ -41,7 +41,6 @@ module GHC.Unit.Home.PackageTable
-- * Queries about home modules
, hptCompleteSigs
, hptAllInstances
- , hptAllFamInstances
, hptAllAnnotations
-- ** More Traversal-based queries
@@ -208,14 +207,6 @@ hptAllInstances hpt = do
let (insts, famInsts) = unzip hits
return (foldl' unionInstEnv emptyInstEnv insts, concat famInsts)
--- | Find all the family instance declarations from the HPT
-hptAllFamInstances :: HomePackageTable -> IO (ModuleEnv FamInstEnv)
-hptAllFamInstances = fmap mkModuleEnv . concatHpt (\hmi -> [(hmiModule hmi, hmiFamInstEnv hmi)])
- where
- hmiModule = mi_module . hm_iface
- hmiFamInstEnv = extendFamInstEnvList emptyFamInstEnv
- . md_fam_insts . hm_details
-
-- | All annotations from the HPT
hptAllAnnotations :: HomePackageTable -> IO AnnEnv
hptAllAnnotations = fmap mkAnnEnv . concatHpt (md_anns . hm_details)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c589f636786ecb43f15c7a3623cb143…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c589f636786ecb43f15c7a3623cb143…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
3405e84e by Simon Peyton Jones at 2025-06-13T17:43:53+01:00
More wibbles
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/HsToCore/Binds.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -29,13 +29,11 @@ import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable
, mkCast, exprType
, stripTicksTop, mkInScopeSetBndrs )
import GHC.Core.FVs
-import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
import GHC.Core.Opt.Arity( collectBindersPushingCo )
--- import GHC.Core.Ppr( pprIds )
import GHC.Builtin.Types ( unboxedUnitTy )
-import GHC.Data.Maybe ( maybeToList, isJust )
+import GHC.Data.Maybe ( isJust )
import GHC.Data.Bag
import GHC.Data.OrdList
import GHC.Data.List.SetOps
@@ -46,7 +44,7 @@ import GHC.Types.Unique.DFM
import GHC.Types.Name
import GHC.Types.Tickish
import GHC.Types.Id.Make ( voidArgId, voidPrimId )
-import GHC.Types.Var ( PiTyBinder(..), isLocalVar, isInvisibleFunArg, mkLocalVar )
+import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Id
@@ -56,6 +54,7 @@ import GHC.Types.Error
import GHC.Utils.Error ( mkMCDiagnostic )
import GHC.Utils.Monad ( foldlM )
import GHC.Utils.Misc
+import GHC.Utils.FV
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -1612,12 +1611,17 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
is_dfun = isDFunId fn
dflags = se_dflags env
this_mod = se_module env
+ subst = se_subst env
+ in_scope = Core.substInScopeSet subst
-- Figure out whether the function has an INLINE pragma
-- See Note [Inline specialisations]
(rhs_bndrs, rhs_body) = collectBindersPushingCo rhs
-- See Note [Account for casts in binding]
+ not_in_scope :: InterestingVarFun
+ not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope)
+
----------------------------------------------------------
-- Specialise to one particular call pattern
spec_call :: SpecInfo -- Accumulating parameter
@@ -1628,25 +1632,40 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
do { let all_call_args | is_dfun = saturating_call_args -- See Note [Specialising DFuns]
| otherwise = call_args
saturating_call_args = call_args ++ map mk_extra_dfun_arg (dropList call_args rhs_bndrs)
- mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType (tyVarKind bndr) -- ToDo: right?
- | otherwise = UnspecArg (idType bndr)
-
- ; (useful, rule_bndrs, rule_lhs_args, spec_bndrs1, spec_args) <- specHeader env all_call_args
-
--- ; pprTrace "spec_call" (vcat
--- [ text "fun: " <+> ppr fn
--- , text "call info: " <+> ppr _ci
--- , text "useful: " <+> ppr useful
--- , text "rule_bndrs:" <+> ppr rule_bndrs
--- , text "lhs_args: " <+> ppr rule_lhs_args
--- , text "spec_bndrs1:" <+> ppr spec_bndrs1
--- , text "spec_args: " <+> ppr spec_args
--- , text "dx_binds: " <+> ppr dx_binds
--- , text "rhs_bndrs" <+> ppr rhs_bndrs
--- , text "rhs_body" <+> ppr rhs_body
--- , text "rhs_env2: " <+> ppr (se_subst rhs_env2)
--- , ppr dx_binds ]) $
--- return ()
+ mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType
+ | otherwise = UnspecArg
+
+ -- Find qvars, the type variables to add to the binders for the rule
+ -- Namely those free in `ty` that aren't in scope
+ -- See (MP2) in Note [Specialising polymorphic dictionaries]
+ ; let poly_qvars = scopedSort $ fvVarList $ specArgsFVs not_in_scope call_args
+ poly_qvar_es = map varToCoreExpr poly_qvars -- Account for CoVars
+
+ subst' = subst `Core.extendSubstInScopeList` poly_qvars
+ -- Maybe we should clone the poly_qvars telescope?
+
+ -- Any free Ids will have caused the call to be dropped
+ ; massertPpr (all isTyCoVar poly_qvars)
+ (ppr fn $$ ppr all_call_args $$ ppr poly_qvars)
+
+ ; (useful, subst'', rule_bndrs, rule_lhs_args, spec_bndrs, spec_args)
+ <- specHeader subst' rhs_bndrs all_call_args
+ ; (rule_bndrs, rule_lhs_args, spec_bndrs, spec_args)
+ <- return ( poly_qvars ++ rule_bndrs, poly_qvar_es ++ rule_lhs_args
+ , poly_qvars ++ spec_bndrs, poly_qvar_es ++ spec_args )
+
+ ; pprTrace "spec_call" (vcat
+ [ text "fun: " <+> ppr fn
+ , text "call info: " <+> ppr _ci
+ , text "poly_qvars: " <+> ppr poly_qvars
+ , text "useful: " <+> ppr useful
+ , text "rule_bndrs:" <+> ppr rule_bndrs
+ , text "rule_lhs_args:" <+> ppr rule_lhs_args
+ , text "spec_bndrs:" <+> ppr spec_bndrs
+ , text "spec_args: " <+> ppr spec_args
+ , text "rhs_bndrs" <+> ppr rhs_bndrs
+ , text "rhs_body" <+> ppr rhs_body ]) $
+ return ()
; let all_rules = rules_acc ++ existing_rules
-- all_rules: we look both in the rules_acc (generated by this invocation
@@ -1657,27 +1676,28 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
then return spec_acc
else
do { -- Run the specialiser on the specialised RHS
- -- The "1" suffix is before we maybe add the void arg
- ; (rhs_body', rhs_uds) <- specRhs env rhs_bndrs rhs_body spec_args
+ (rhs_body', rhs_uds) <- specExpr (env { se_subst = subst'' }) $
+ mkLams (dropList spec_args rhs_bndrs) rhs_body
+
-- Add the { d1' = dx1; d2' = dx2 } usage stuff
-- to the rhs_uds; see Note [Specialising Calls]
; let (spec_uds, dumped_dbs) = dumpUDs spec_bndrs1 rhs_uds
- spec_rhs1 = mkLams spec_bndrs1 $
- wrapDictBindsE dumped_dbs rhs_body'
- spec_fn_ty1 = exprType spec_rhs1
+ spec_rhs = mkLams spec_bndrs $
+ wrapDictBindsE dumped_dbs rhs_body'
+ spec_fn_ty = exprType spec_rhs
-- Maybe add a void arg to the specialised function,
-- to avoid unlifted bindings
-- See Note [Specialisations Must Be Lifted]
-- C.f. GHC.Core.Opt.WorkWrap.Utils.needsVoidWorkerArg
- add_void_arg = isUnliftedType spec_fn_ty1 && not (isJoinId fn)
- (spec_bndrs, spec_rhs, spec_fn_ty)
- | add_void_arg = ( voidPrimId : spec_bndrs1
- , Lam voidArgId spec_rhs1
- , mkVisFunTyMany unboxedUnitTy spec_fn_ty1)
- | otherwise = (spec_bndrs1, spec_rhs1, spec_fn_ty1)
+ add_void_arg = isUnliftedType spec_fn_ty && not (isJoinId fn)
+ (spec_bndrs1, spec_rhs1, spec_fn_ty1)
+ | add_void_arg = ( voidPrimId : spec_bndrs
+ , Lam voidArgId spec_rhs
+ , mkVisFunTyMany unboxedUnitTy spec_fn_ty)
+ | otherwise = (spec_bndrs, spec_rhs, spec_fn_ty)
- join_arity_decr = length rule_lhs_args - length spec_bndrs
+ join_arity_decr = length rule_lhs_args - length spec_bndrs1
--------------------------------------
-- Add a suitable unfolding; see Note [Inline specialisations]
@@ -1685,7 +1705,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- arguments, not forgetting to wrap the dx_binds around the outside (#22358)
simpl_opts = initSimpleOpts dflags
wrap_unf_body body = body `mkApps` spec_args
- spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body
+ spec_unf = specUnfolding simpl_opts spec_bndrs1 wrap_unf_body
rule_lhs_args fn_unf
--------------------------------------
@@ -1693,7 +1713,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- See Note [Arity decrease] in GHC.Core.Opt.Simplify
-- Copy InlinePragma information from the parent Id.
-- So if f has INLINE[1] so does spec_fn
- arity_decr = count isValArg rule_lhs_args - count isId spec_bndrs
+ arity_decr = count isValArg rule_lhs_args - count isId spec_bndrs1
spec_inl_prag
| not is_local -- See Note [Specialising imported functions]
@@ -1715,7 +1735,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
DFunId unary -> DFunId unary
_ -> VanillaId
- ; spec_fn <- newSpecIdSM (idName fn) spec_fn_ty spec_fn_details spec_fn_info
+ ; spec_fn <- newSpecIdSM (idName fn) spec_fn_ty1 spec_fn_details spec_fn_info
; let
-- The rule to put in the function's specialisation is:
-- forall x @b d1' d2'.
@@ -1728,12 +1748,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
spec_rule = mkSpecRule dflags this_mod True inl_act
herald fn rule_bndrs rule_lhs_args
- (mkVarApps (Var spec_fn) spec_bndrs)
+ (mkVarApps (Var spec_fn) spec_bndrs1)
spec_f_w_arity = spec_fn
_rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type
- , ppr spec_fn <+> dcolon <+> ppr spec_fn_ty
+ , ppr spec_fn <+> dcolon <+> ppr spec_fn_ty1
, ppr rhs_bndrs, ppr call_args
, ppr spec_rule
, text "acc" <+> ppr rules_acc
@@ -1742,7 +1762,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
; -- pprTrace "spec_call: rule" _rule_trace_doc
return ( spec_rule : rules_acc
- , (spec_f_w_arity, spec_rhs) : pairs_acc
+ , (spec_f_w_arity, spec_rhs1) : pairs_acc
, spec_uds `thenUDs` uds_acc
) } }
@@ -1763,13 +1783,16 @@ alreadyCovered env bndrs fn args is_active rules
where
in_scope = substInScopeSet (se_subst env)
-specRhs :: SpecEnv -> [Var] -> CoreExpr -> [CoreExpr]
- -> SpecM (CoreExpr, UsageDetails)
+{-
+specRhs :: SpecEnv -> [InVar] -> InExpr -> [OutExpr]
+ -> SpecM (OutExpr, UsageDetails)
-specRhs env bndrs body []
- = specLam env bndrs body
+specRhs env bndrs body [] -- Like specExpr (Lam bndrs body)
+ = specLam env' bndrs' body
+ where
+ (env', bndrs') = substBndrs env bndrs
-specRhs env [] body args
+specRhs _env [] body args
= -- The caller should have ensured that there are no more
-- args than we have binders on the RHS
pprPanic "specRhs:too many args" (ppr args $$ ppr body)
@@ -1781,15 +1804,22 @@ specRhs env@(SE { se_subst = subst }) (bndr:bndrs) body (arg:args)
| otherwise -- Non-trivial argument; it must be a dictionary
- = do { fresh_dict_id <- newIdBndr "dx" (idType bndr)
- ; let fresh_dict_id' = fresh_dict_id `addDictUnfolding` arg
- dict_bind = mkDB (NonRec fresh_dict_id' arg)
- env2 = env1 { se_subst = Core.extendSubst subst bndr (Var fresh_dict_id')
- `Core.extendSubstInScope` fresh_dict_id' }
+ = do { fresh_id <- newIdBndr "dx" (exprType arg)
+ ; let fresh_id' = fresh_id `addDictUnfolding` arg
+ dict_bind = mkDB (NonRec fresh_id' arg)
+ env' = env { se_subst = Core.extendSubst subst bndr (Var fresh_id')
+ `Core.extendSubstInScope` fresh_id' }
-- Ensure the new unfolding is in the in-scope set
- ; (body', uds) <- specRhs env2 bndrs body args
+ ; (body', uds) <- specRhs env' bndrs body args
; return (body', dict_bind `consDictBind` uds) }
+consDictBind :: DictBind -> UsageDetails -> UsageDetails
+consDictBind db uds@MkUD{ud_binds=FDB{fdb_binds = binds, fdb_bndrs = bs}}
+ = uds { ud_binds = FDB{ fdb_binds = db `consOL` binds
+ , fdb_bndrs = bs `extendVarSetList` bindersOfDictBind db } }
+
+-}
+
-- Convenience function for invoking lookupRule from Specialise
-- The SpecEnv's InScopeSet should include all the Vars in the [CoreExpr]
specLookupRule :: SpecEnv -> Id -> [CoreExpr]
@@ -2105,17 +2135,20 @@ defeated specialisation! Hence the use of collectBindersPushingCo.
Note [Evidence foralls]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose (#12212) that we are specialising
- f :: forall a b. (Num a, F a ~ F b) => blah
+ f :: forall a b. (Num a, F a ~# F b) => blah
with a=b=Int. Then the RULE will be something like
- RULE forall (d:Num Int) (g :: F Int ~ F Int).
+ RULE forall (d:Num Int) (g :: F Int ~# F Int).
f Int Int d g = f_spec
+where that `g` is really (Coercion (CoVar g)), since `g` is a
+coercion variable and can't appear as (Var g).
+
But both varToCoreExpr (when constructing the LHS args), and the
simplifier (when simplifying the LHS args), will transform to
RULE forall (d:Num Int) (g :: F Int ~ F Int).
f Int Int d <F Int> = f_spec
by replacing g with Refl. So now 'g' is unbound, which results in a later
crash. So we use Refl right off the bat, and do not forall-quantify 'g':
- * varToCoreExpr generates a Refl
+ * varToCoreExpr generates a (Coercion Refl)
* exprsFreeIdsList returns the Ids bound by the args,
which won't include g
@@ -2447,7 +2480,7 @@ data SpecArg
SpecType Type
-- | Type arguments that should remain polymorphic.
- | UnspecType Kind
+ | UnspecType
-- | Dictionaries that should be specialised. mkCallUDs ensures
-- that only "interesting" dictionary arguments get a SpecDict;
@@ -2455,25 +2488,25 @@ data SpecArg
| SpecDict DictExpr
-- | Value arguments that should not be specialised.
- | UnspecArg Type
+ | UnspecArg
instance Outputable SpecArg where
- ppr (SpecType t) = text "SpecType" <+> ppr t
- ppr (UnspecType k) = text "UnspecType"
- ppr (SpecDict d) = text "SpecDict" <+> ppr d
- ppr (UnspecArg t) = text "UnspecArg"
-
-specArgFreeIds :: SpecArg -> IdSet
-specArgFreeIds (SpecType {}) = emptyVarSet
-specArgFreeIds (SpecDict dx) = exprFreeIds dx
-specArgFreeIds (UnspecType {}) = emptyVarSet
-specArgFreeIds (UnspecArg {}) = emptyVarSet
-
-specArgFreeVars :: SpecArg -> VarSet
-specArgFreeVars (SpecType ty) = tyCoVarsOfType ty
-specArgFreeVars (UnspecType ki) = tyCoVarsOfType ki
-specArgFreeVars (SpecDict dx) = exprFreeVars dx
-specArgFreeVars (UnspecArg ty) = tyCoVarsOfType ty
+ ppr (SpecType t) = text "SpecType" <+> ppr t
+ ppr (SpecDict d) = text "SpecDict" <+> ppr d
+ ppr UnspecType = text "UnspecType"
+ ppr UnspecArg = text "UnspecArg"
+
+specArgsFVs :: InterestingVarFun -> [SpecArg] -> FV
+-- Find the free vars of the SpecArgs that are not already in scope
+specArgsFVs interesting args
+ = filterFV interesting $
+ foldr (unionFV . get) emptyFV args
+ where
+ get :: SpecArg -> FV
+ get (SpecType ty) = tyCoFVsOfType ty
+ get (SpecDict dx) = exprFVs dx
+ get UnspecType = emptyFV
+ get UnspecArg = emptyFV
isSpecDict :: SpecArg -> Bool
isSpecDict (SpecDict {}) = True
@@ -2523,12 +2556,15 @@ isSpecDict _ = False
-- , [T1, T2, c, i, dEqT1, dShow1]
-- )
specHeader
- :: SpecEnv
+ :: Core.Subst -- This substitution applies to the [InBndr]
+ -> [InBndr] -- Binders from the original function `f`
-> [SpecArg] -- From the CallInfo
-> SpecM ( Bool -- True <=> some useful specialisation happened
-- Not the same as any (isSpecDict args) because
-- the args might be longer than bndrs
+ , Core.Subst -- Apply this to the body
+
-- RULE helpers
, [OutBndr] -- Binders for the RULE
, [OutExpr] -- Args for the LHS of the rule
@@ -2539,63 +2575,57 @@ specHeader
-- Same length as "Args for LHS of rule"
)
+-- If we run out of binders, stop immediately
+-- See Note [Specialisation Must Preserve Sharing]
+specHeader subst [] _ = pure (False, subst, [], [], [], [])
+specHeader subst _ [] = pure (False, subst, [], [], [], [])
+
-- We want to specialise on type 'T1', and so we must construct a substitution
-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding
-- details.
-specHeader env (SpecType ty : args)
- = do { -- Find qvars, the type variables to add to the binders for the rule
- -- Namely those free in `ty` that aren't in scope
- -- See (MP2) in Note [Specialising polymorphic dictionaries]
- let in_scope = Core.substInScopeSet (se_subst env)
- qvars = scopedSort $
- filterOut (`elemInScopeSet` in_scope) $
- tyCoVarsOfTypeList ty
- ; (useful, rule_bs, rule_args, spec_bs, spec_args) <- specHeader env args
- ; pure ( useful
- , qvars ++ rule_bs
- , Type ty : rule_args
- , qvars ++ spec_bs
- , Type ty : spec_args
- )
- }
+specHeader subst (bndr:bndrs) (SpecType ty : args)
+ = do { let subst1 = Core.extendTvSubst subst bndr ty
+ ; (useful, subst2, rule_bs, rule_args, spec_bs, spec_args)
+ <- specHeader subst1 bndrs args
+ ; pure ( useful, subst2
+ , rule_bs, Type ty : rule_args
+ , spec_bs, Type ty : spec_args ) }
-- Next we have a type that we don't want to specialise. We need to perform
-- a substitution on it (in case the type refers to 'a'). Additionally, we need
-- to produce a binder, LHS argument and RHS argument for the resulting rule,
-- /and/ a binder for the specialised body.
-specHeader env (UnspecType kind : args)
- = do { (useful, rule_bs, rule_es, spec_bs, spec_args) <- specHeader env' bndrs args
- ; tv <- newTyVarBndr kind
- ; pure ( useful
- , bndr' : rule_bs
- , varToCoreExpr bndr' : rule_es
- , bndr' : spec_bs
- , varToCoreExpr bndr' : spec_args
- )
- }
+specHeader subst (bndr:bndrs) (UnspecType : args)
+ = do { let (subst1, bndr') = Core.substBndr subst bndr
+ ; (useful, subst2, rule_bs, rule_es, spec_bs, spec_args)
+ <- specHeader subst1 bndrs args
+ ; let ty_e' = Type (mkTyVarTy bndr')
+ ; pure ( useful, subst2
+ , bndr' : rule_bs, ty_e' : rule_es
+ , bndr' : spec_bs, ty_e' : spec_args ) }
+
+specHeader subst (bndr:bndrs) (_ : args)
+ | isDeadBinder bndr
+ , let (subst1, bndr') = Core.substBndr subst bndr
+ , Just rubbish_lit <- mkLitRubbish (idType bndr')
+ = -- See Note [Drop dead args from specialisations]
+ do { (useful, subst2, rule_bs, rule_es, spec_bs, spec_args) <- specHeader subst1 bndrs args
+ ; pure ( useful, subst2
+ , bndr' : rule_bs, Var bndr' : rule_es
+ , spec_bs, rubbish_lit : spec_args ) }
-- Next we want to specialise the 'Eq a' dict away. We need to construct
-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for
-- the nitty-gritty), as a LHS rule and unfolding details.
-specHeader env (SpecDict dict_arg : args)
- | not (isDeadBinder bndr)
- , allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d)
- -- See Note [Weird special case for SpecDict]
- = do { (_, rule_bs, rule_es, spec_bs, spec_args) <- specHeader env bndrs args
- ; new_dict_id <- newIdBndr "dx" (exprType dict_arg)
- ; let new_dict_expr = varToCoreExpr new_dict_id
- -- See Note [Evidence foralls]
- ; pure ( True -- Ha! A useful specialisation!
- , exprFreeIdsList new_dict_expr ++ rule_bs
- , new_dict_expr : rule_es
- , spec_bs
- , dict_arg : spec_args
- )
- }
+specHeader subst (bndr:bndrs) (SpecDict dict_arg : args)
+ = do { let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr)
+ -- zapIdOccInfo: see Note [Zap occ info in rule binders]
+ ; (_, subst2, rule_bs, rule_es, spec_bs, spec_args) <- specHeader subst1 bndrs args
+ ; pure ( True, subst2 -- Ha! A useful specialisation!
+ , bndr' : rule_bs, Var bndr' : rule_es
+ , spec_bs, dict_arg : spec_args ) }
-- Finally, we don't want to specialise on this argument 'i':
--- - It's an UnSpecArg, or
--- - It's a dead dictionary
-- We need to produce a binder, LHS and RHS argument for the RULE, and
-- a binder for the specialised body.
--
@@ -2603,46 +2633,21 @@ specHeader env (SpecDict dict_arg : args)
-- why 'i' doesn't appear in our RULE above. But we have no guarantee that
-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so
-- this case must be here.
-specHeader env (arg : args)
- -- The "_" can be UnSpecArg, or SpecDict where the bndr is dead
- = do { -- see Note [Zap occ info in rule binders]
- ; (useful, rule_bs, rule_es, spec_bs, spec_args) <- specHeader env bndrs args
-
- ; spec_bndr <- case arg of
- SpecDict d -> newIdBndr "dx" (exprType d)
- UnspecArg t -> newIdBndr "x" t
- ; let bndr_ty = idType bndr'
-
- -- See Note [Drop dead args from specialisations]
- -- C.f. GHC.Core.Opt.WorkWrap.Utils.mk_absent_let
- (mb_spec_bndr, spec_arg)
- | isDeadBinder bndr
- , Just lit_expr <- mkLitRubbish bndr_ty
- = (Nothing, lit_expr)
- | otherwise
- = (Just bndr', varToCoreExpr bndr')
-
- ; pure ( useful
- , bndr' : rule_bs
- , varToCoreExpr bndr' : rule_es
- , case mb_spec_bndr of
- Just b -> b : spec_bs
- Nothing -> spec_bs
- , spec_arg : spec_args
- )
- }
+specHeader subst (bndr:bndrs) (UnspecArg : args)
+ = do { let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr)
+ -- zapIdOccInfo: see Note [Zap occ info in rule binders]
+ ; (useful, subst2, rule_bs, rule_es, spec_bs, spec_args) <- specHeader subst1 bndrs args
--- If we run out of binders, stop immediately
--- See Note [Specialisation Must Preserve Sharing]
-specHeader env [] _ = pure (False, env, [], [], [], [], [], [])
+ ; let dummy_arg = varToCoreExpr bndr'
+ -- dummy_arg is usually just (Var bndr),
+ -- but if bndr :: t1 ~# t2, it'll be (Coercion (CoVar bndr))
+ -- or even Coercion Refl (if t1=t2)
+ -- See Note [Evidence foralls]
+ bndrs = exprFreeIdsList dummy_arg
--- Return all remaining binders from the original function. These have the
--- invariant that they should all correspond to unspecialised arguments, so
--- it's safe to stop processing at this point.
-specHeader env bndrs []
- = pure (False, env', bndrs', [], [], [], [], [])
- where
- (env', bndrs') = substBndrs env bndrs
+ ; pure ( useful, subst2
+ , bndrs ++ rule_bs, dummy_arg : rule_es
+ , bndrs ++ spec_bs, dummy_arg : spec_args ) }
{-
@@ -2672,12 +2677,12 @@ bindAuxiliaryDict env@(SE { se_subst = subst })
-- Ensure the new unfolding is in the in-scope set
in -- pprTrace "bindAuxiliaryDict:non-trivial" (ppr orig_dict_id <+> ppr fresh_dict_id') $
(env', Just dict_bind, Var fresh_dict_id')
--}
addDictUnfolding :: Id -> CoreExpr -> Id
-- Add unfolding for freshly-bound Ids: see Note [Make the new dictionaries interesting]
-- and Note [Specialisation modulo dictionary selectors]
addDictUnfolding id rhs
= id `setIdUnfolding` mkSimpleUnfolding defaultUnfoldingOpts rhs
+-}
{-
Note [Make the new dictionaries interesting]
@@ -2985,14 +2990,12 @@ singleCall spec_env id args
= MkUD {ud_binds = emptyFDBs,
ud_calls = unitDVarEnv id $ CIS id $
unitBag (CI { ci_key = args
- , ci_fvs = call_fvs }) }
+ , ci_fvs = fvVarSet call_fvs }) }
where
- call_fvs = foldr (unionVarSet . free_var_fn) emptyVarSet args
-
- free_var_fn =
- if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env)
- then specArgFreeIds
- else specArgFreeVars
+ call_fvs | gopt Opt_PolymorphicSpecialisation (se_dflags spec_env)
+ = specArgsFVs isLocalVar args
+ | otherwise
+ = specArgsFVs isLocalId args
-- specArgFreeIds: we specifically look for free Ids, not TyVars
-- see (MP1) in Note [Specialising polymorphic dictionaries]
@@ -3033,9 +3036,9 @@ mkCallUDs' env f args
| binderVar bndr `elemVarSet` constrained_tyvars
= SpecType ty
| otherwise
- = UnspecType (typeKind ty)
+ = UnspecType
mk_spec_arg non_type_arg (Named bndr)
- = = pprPanic "ci_key" $ (ppr non_type_arg $$ ppr bndr)
+ = pprPanic "ci_key" $ (ppr non_type_arg $$ ppr bndr)
-- For "invisibleFunArg", which are the type-class dictionaries,
-- we decide on a case by case basis if we want to specialise
@@ -3046,7 +3049,7 @@ mkCallUDs' env f args
-- See Note [Interesting dictionary arguments]
= SpecDict arg
- | otherwise = UnspecArg (exprType arg)
+ | otherwise = UnspecArg
{-
Note [Ticks on applications]
@@ -3285,11 +3288,6 @@ snocDictBinds uds@MkUD{ud_binds=FDB{ fdb_binds = binds, fdb_bndrs = bs }} dbs
= uds { ud_binds = FDB { fdb_binds = binds `appOL` (toOL dbs)
, fdb_bndrs = bs `extendVarSetList` bindersOfDictBinds dbs } }
-consDictBind :: DictBind -> UsageDetails -> UsageDetails
-consDictBind db uds@MkUD{ud_binds=FDB{fdb_binds = binds, fdb_bndrs = bs}}
- = uds { ud_binds = FDB{ fdb_binds = db `consOL` binds
- , fdb_bndrs = bs `extendVarSetList` bindersOfDictBind db } }
-
wrapDictBinds :: FloatedDictBinds -> [CoreBind] -> [CoreBind]
wrapDictBinds (FDB { fdb_binds = dbs }) binds
= foldr add binds dbs
@@ -3402,10 +3400,10 @@ beats_or_same (CI { ci_key = args1 }) (CI { ci_key = args2 })
go _ _ = False
go_arg (SpecType ty1) (SpecType ty2) = isJust (tcMatchTy ty1 ty2)
- go_arg (UnspecType {}) (UnspecType {}) = True
- go_arg (SpecDict {}) (SpecDict {}) = True
- go_arg (UnspecArg {}) (UnspecArg {}) = True
- go_arg _ _ = False
+ go_arg (SpecDict {}) (SpecDict {}) = True
+ go_arg UnspecType UnspecType = True
+ go_arg UnspecArg UnspecArg = True
+ go_arg _ _ = False
----------------------
splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet)
@@ -3471,9 +3469,9 @@ mapAndCombineSM f (x:xs) = do (y, uds1) <- f x
(ys, uds2) <- mapAndCombineSM f xs
return (y:ys, uds1 `thenUDs` uds2)
-extendTvSubst :: SpecEnv -> TyVar -> Type -> SpecEnv
-extendTvSubst env tv ty
- = env { se_subst = Core.extendTvSubst (se_subst env) tv ty }
+-- extendTvSubst :: SpecEnv -> TyVar -> Type -> SpecEnv
+-- extendTvSubst env tv ty
+-- = env { se_subst = Core.extendTvSubst (se_subst env) tv ty }
extendInScope :: SpecEnv -> OutId -> SpecEnv
extendInScope env@(SE { se_subst = subst }) bndr
@@ -3521,18 +3519,6 @@ newSpecIdSM old_name new_ty details info
; return (assert (not (isCoVarType new_ty)) $
mkLocalVar details new_name ManyTy new_ty info) }
-newIdBndr :: String -> Type -> SpecM (SpecEnv, CoreBndr)
--- Make up completely fresh binders for the dictionaries
--- Their bindings are going to float outwards
-newIdBndr env@(SE { se_subst = subst }) str ty
- = do { uniq <- getUniqueM
- ; return (mkUserLocal (mkVarOcc str) uniq ManyTy ty noSrcSpan) }
-
-newTyVarBndr :: Kind -> SpecM TyVar
-newTyVarBndr kind
- = do { uniq <- getUniqueM
- ; let name = mkInternalName uniq (mkTyVarOcc "a") noSrcSpan
- ; return (mkTyVar name kind }
{-
Old (but interesting) stuff about unboxed bindings
=====================================
compiler/GHC/Core/Subst.hs
=====================================
@@ -163,12 +163,14 @@ extendIdSubstList (Subst in_scope ids tvs cvs) prs
-- | Add a substitution appropriate to the thing being substituted
-- (whether an expression, type, or coercion). See also
-- 'extendIdSubst', 'extendTvSubst', 'extendCvSubst'
-extendSubst :: Subst -> Var -> CoreArg -> Subst
+extendSubst :: HasDebugCallStack => Subst -> Var -> CoreArg -> Subst
extendSubst subst var arg
= case arg of
- Type ty -> assert (isTyVar var) $ extendTvSubst subst var ty
- Coercion co -> assert (isCoVar var) $ extendCvSubst subst var co
- _ -> assert (isId var) $ extendIdSubst subst var arg
+ Type ty -> assertPpr (isTyVar var) doc $ extendTvSubst subst var ty
+ Coercion co -> assertPpr (isCoVar var) doc $ extendCvSubst subst var co
+ _ -> assertPpr (isId var) doc $ extendIdSubst subst var arg
+ where
+ doc = ppr var <+> text ":=" <+> ppr arg
extendSubstWithVar :: Subst -> Var -> Var -> Subst
extendSubstWithVar subst v1 v2
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1056,25 +1056,6 @@ dsSpec poly_rhs (SpecPrag poly_id spec_co spec_inl)
dsSpec_help (idName poly_id) poly_id poly_rhs
spec_inl spec_bndrs (core_app (Var poly_id))
-{-
- do { dflags <- getDynFlags
- ; case decomposeRuleLhs dflags spec_bndrs (core_app (Var poly_id))
- (mkVarSet spec_bndrs) of {
- Left msg -> do { diagnosticDs msg; return Nothing } ;
- Right (rule_bndrs, poly_id, rule_lhs_args) ->
-
- do { tracePm "dsSpec(old route)" $
- vcat [ text "poly_id" <+> ppr poly_id
- , text "spec_bndrs" <+> ppr spec_bndrs
- , text "the_call" <+> ppr (core_app (Var poly_id))
- , text "rule_bndrs" <+> ppr rule_bndrs
- , text "rule_lhs_args" <+> ppr rule_lhs_args ]
-
- ; finishSpecPrag (idName poly_id) poly_rhs
- rule_bndrs poly_id rule_lhs_args
- spec_bndrs core_app spec_inl } } }
--}
-
dsSpec poly_rhs (SpecPragE { spe_fn_nm = poly_nm
, spe_fn_id = poly_id
, spe_inl = inl
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3405e84ed1b7d4afd30b577c38b2bb5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3405e84ed1b7d4afd30b577c38b2bb5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0