[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: compiler: Rejects RULES whose LHS immediately fails to type-check
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jun 17 15:04:13 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
db343324 by Fabricio de Sousa Nascimento at 2024-06-17T10:01:51-04:00
compiler: Rejects RULES whose LHS immediately fails to type-check
Fixes GHC crashing on `decomposeRuleLhs` due to ignoring coercion values. This
happens when we have a RULE that does not type check, and enable
`-fdefer-type-errors`. We prevent this to happen by rejecting RULES with an
immediately LHS type error.
Fixes #24026
- - - - -
e7a95662 by Dylan Thinnes at 2024-06-17T10:02:35-04:00
Add hscTypecheckRenameWithDiagnostics, for HLS (#24996)
Use runHsc' in runHsc so that both functions can't fall out of sync
We're currently copying parts of GHC code to get structured warnings
in HLS, so that we can recreate `hscTypecheckRenameWithDiagnostics`
locally. Once we get this function into GHC we can drop the copied code
in future versions of HLS.
- - - - -
70ef2878 by David Binder at 2024-06-17T11:03:55-04:00
Add RTS flag --read-tix-file (GHC Proposal 612)
This commit introduces the RTS flag `--read-tix-file=<yes|no>` which
controls whether a preexisting .tix file is read in at the beginning
of a program run. The default is currently `--read-tix-file=yes` but
will change to `--read-tix-file=no` in a future release of GHC. For
this reason, whenever a .tix file is read in a warning is emitted to
stderr. This warning can be silenced by explicitly passing the
`--read-tix-file=yes` option. Details can be found in the GHC proposal
cited below.
Users can query whether this flag has been used with the help of the
module `GHC.RTS.Flags`. A new field `readTixFile` was added to the
record `HpcFlags`.
These changes have been discussed and approved in
- GHC proposal 612: https://github.com/ghc-proposals/ghc-proposals/pull/612
- CLC proposal 276: https://github.com/haskell/core-libraries-committee/issues/276
- - - - -
460e65ed by Andreas Klebinger at 2024-06-17T11:03:56-04:00
GHCi interpreter: Tag constructor closures when possible.
When evaluating PUSH_G try to tag the reference we are pushing if it's a
constructor or function. This is potentially helpful for performance and required to
fix #24870.
- - - - -
28 changed files:
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/Tc/Gen/Rule.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/profiling.rst
- docs/users_guide/runtime_control.rst
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- rts/Hpc.c
- rts/Interpreter.c
- rts/RtsFlags.c
- rts/include/rts/Flags.h
- 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/th/should_compile/T24870/Def.hs
- + testsuite/tests/th/should_compile/T24870/T24870.stderr
- + testsuite/tests/th/should_compile/T24870/T24870.stderr-mingw32
- + testsuite/tests/th/should_compile/T24870/Use.hs
- + testsuite/tests/th/should_compile/T24870/all.T
- + testsuite/tests/typecheck/T24026/T24026a.hs
- + testsuite/tests/typecheck/T24026/T24026a.stderr
- + testsuite/tests/typecheck/T24026/T24026b.hs
- + testsuite/tests/typecheck/T24026/T24026b.stderr
- + testsuite/tests/typecheck/T24026/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -83,7 +83,7 @@ data BCInstr
| PUSH16_W !ByteOff
| PUSH32_W !ByteOff
- -- Push a ptr (these all map to PUSH_G really)
+ -- Push a (heap) ptr (these all map to PUSH_G really)
| PUSH_G Name
| PUSH_PRIMOP PrimOp
| PUSH_BCO (ProtoBCO Name)
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -86,8 +86,8 @@ import qualified Data.Set as Set
import GHC.Unit.Module.Graph
runHsc :: HscEnv -> Hsc a -> IO a
-runHsc hsc_env (Hsc hsc) = do
- (a, w) <- hsc hsc_env emptyMessages
+runHsc hsc_env hsc = do
+ (a, w) <- runHsc' hsc_env hsc
let dflags = hsc_dflags hsc_env
let !diag_opts = initDiagOpts dflags
!print_config = initPrintConfig dflags
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -64,6 +64,7 @@ module GHC.Driver.Main
, hscRecompStatus
, hscParse
, hscTypecheckRename
+ , hscTypecheckRenameWithDiagnostics
, hscTypecheckAndGetWarnings
, hscDesugar
, makeSimpleDetails
@@ -642,7 +643,14 @@ extract_renamed_stuff mod_summary tc_result = do
-- | Rename and typecheck a module, additionally returning the renamed syntax
hscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule
-> IO (TcGblEnv, RenamedStuff)
-hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $
+hscTypecheckRename hsc_env mod_summary rdr_module =
+ fst <$> hscTypecheckRenameWithDiagnostics hsc_env mod_summary rdr_module
+
+-- | Rename and typecheck a module, additionally returning the renamed syntax
+-- and the diagnostics produced.
+hscTypecheckRenameWithDiagnostics :: HscEnv -> ModSummary -> HsParsedModule
+ -> IO ((TcGblEnv, RenamedStuff), Messages GhcMessage)
+hscTypecheckRenameWithDiagnostics hsc_env mod_summary rdr_module = runHsc' hsc_env $
hsc_typecheck True mod_summary (Just rdr_module)
-- | Do Typechecking without throwing SourceError exception with -Werror
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1031,9 +1031,12 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs rhs_fvs
extra_bndrs = scopedSort extra_tvs ++ extra_dicts
where
extra_tvs = [ v | v <- extra_vars, isTyVar v ]
+
+ -- isEvVar: this includes coercions, matching what
+ -- happens in `split_lets` (isDictId, isCoVar)
extra_dicts =
- [ mkLocalId (localiseName (idName d)) ManyTy (idType d)
- | d <- extra_vars, isDictId d ]
+ [ mkLocalIdOrCoVar (localiseName (idName d)) ManyTy (idType d)
+ | d <- extra_vars, isEvVar d ]
extra_vars =
[ v
| v <- exprsFreeVarsList args
=====================================
compiler/GHC/Tc/Gen/Rule.hs
=====================================
@@ -108,11 +108,13 @@ tcRules decls = mapM (wrapLocMA tcRuleDecls) decls
tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTc)
tcRuleDecls (HsRules { rds_ext = src
, rds_rules = decls })
- = do { tc_decls <- mapM (wrapLocMA tcRule) decls
+ = do { maybe_tc_decls <- mapM (wrapLocMA tcRule) decls
+ ; let tc_decls = [L loc rule | (L loc (Just rule)) <- maybe_tc_decls]
; return $ HsRules { rds_ext = src
, rds_rules = tc_decls } }
-tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTc)
+
+tcRule :: RuleDecl GhcRn -> TcM (Maybe (RuleDecl GhcTc))
tcRule (HsRule { rd_ext = ext
, rd_name = rname@(L _ name)
, rd_act = act
@@ -181,7 +183,17 @@ tcRule (HsRule { rd_ext = ext
; (rhs_implic, rhs_binds) <- buildImplicationFor tc_lvl (getSkolemInfo skol_info) qtkvs
lhs_evs rhs_wanted
; emitImplications (lhs_implic `unionBags` rhs_implic)
- ; return $ HsRule { rd_ext = ext
+
+ -- A type error on the LHS of a rule will be reported earlier while solving for
+ -- lhs_implic. However, we should also drop the rule entirely for cases where
+ -- compilation continues regardless of the error. For example with
+ -- `-fdefer-type-errors`, where this ill-typed LHS rule may cause follow-on errors
+ -- (#24026).
+ ; if anyBag insolubleImplic lhs_implic
+ then
+ return Nothing -- The RULE LHS does not type-check and will be dropped.
+ else
+ return . Just $ HsRule { rd_ext = ext
, rd_name = rname
, rd_act = act
, rd_tyvs = ty_bndrs -- preserved for ppr-ing
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -91,6 +91,11 @@ Runtime system
- Reduce fragmentation incurred by the nonmoving GC's segment allocator. In one application this reduced resident set size by 26%. See :ghc-ticket:`24150`.
+- The new runtime flag :rts-flag:`--read-tix-file=\<yes|no\>` allows to modify whether a preexisting .tix file is read in at the beginning of a program run.
+ The default is currently ``--read-tix-file=yes`` but will change to ``--read-tix-file=no`` in a future version of GHC.
+ For this reason, a warning is emitted if a .tix file is read in implicitly. You can silence this warning by explicitly passing ``--read-tix-file=yes``.
+ Details can be found in `GHC proposal 612 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0612-fhpc-accumulation.md>`__.
+
``base`` library
~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/profiling.rst
=====================================
@@ -1502,9 +1502,9 @@ Running the program generates a file with the ``.tix`` suffix, in this
case :file:`Recip.tix`, which contains the coverage data for this run of the
program. The program may be run multiple times (e.g. with different test
data), and the coverage data from the separate runs is accumulated in
-the ``.tix`` file. To reset the coverage data and start again, just
-remove the ``.tix`` file. You can control where the ``.tix`` file
-is generated using the environment variable :envvar:`HPCTIXFILE`.
+the ``.tix`` file. This behaviour can be controlled with the :rts-flag:`--read-tix-file=\<yes|no\>`
+You can control where the ``.tix`` file is generated using the
+environment variable :envvar:`HPCTIXFILE`.
.. envvar:: HPCTIXFILE
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -1373,7 +1373,22 @@ and can be controlled by the following flags.
.. index::
single: RTS options, hpc
-.. rts-flag:: --write-tix-file
+.. rts-flag:: --read-tix-file=<yes|no>
+
+ :default: enabled
+ :since: 9.12
+
+ The RTS can be instructed to read a ``<program>.tix`` file during the startup
+ phase. The datastructures which accumulate the coverage information during
+ program execution are then initialized with the information from this file.
+ This option is useful for aggregating coverage information over multiple runs
+ of an executable.
+
+ The default for this flag is currently ``--read-tix-file=yes`` but will change
+ to ``-read-tix-file=no`` in a future version of GHC according to the accepted
+ `GHC proposal 612 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0612-fhpc-accumulation.md>`__.
+
+.. rts-flag:: --write-tix-file=<yes|no>
:default: enabled
:since: 9.10
=====================================
libraries/base/changelog.md
=====================================
@@ -1,6 +1,7 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.21.0.0 *TBA*
+ * Add a `readTixFile` field to the `HpcFlags` record in `GHC.RTS.Flags` ([CLC proposal #276](https://github.com/haskell/core-libraries-committee/issues/276))
* Add the `MonadFix` instance for `(,) a`, similar to the one for `Writer a` ([CLC proposal #238](https://github.com/haskell/core-libraries-committee/issues/238))
* Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))
* Make `flip` representation polymorphic ([CLC proposal #245](https://github.com/haskell/core-libraries-committee/issues/245))
=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
=====================================
@@ -382,7 +382,11 @@ data ParFlags = ParFlags
--
-- @since base-4.20.0.0
data HpcFlags = HpcFlags
- { writeTixFile :: Bool
+ { readTixFile :: Bool
+ -- ^ Controls whether a @<program>.tix@ file is read at
+ -- the start of execution to initialize the RTS internal
+ -- HPC datastructures.
+ , writeTixFile :: Bool
-- ^ Controls whether the @<program>.tix@ file should be
-- written after the execution of the program.
}
@@ -498,6 +502,8 @@ getHpcFlags = do
let ptr = (#ptr RTS_FLAGS, HpcFlags) rtsFlagsPtr
HpcFlags
<$> (toBool <$>
+ (#{peek HPC_FLAGS, readTixFile} ptr :: IO CBool))
+ <*> (toBool <$>
(#{peek HPC_FLAGS, writeTixFile} ptr :: IO CBool))
getConcFlags :: IO ConcFlags
=====================================
rts/Hpc.c
=====================================
@@ -236,7 +236,14 @@ startupHpc(void)
sprintf(tixFilename, "%s.tix", prog_name);
}
- if (init_open(__rts_fopen(tixFilename,"r"))) {
+ if ((RtsFlags.HpcFlags.readTixFile == HPC_YES_IMPLICIT) && init_open(__rts_fopen(tixFilename,"r"))) {
+ fprintf(stderr,"Deprecation warning:\n"
+ "I am reading in the existing tix file, and will add hpc info from this run to the existing data in that file.\n"
+ "GHC 9.14 will cease looking for an existing tix file by default.\n"
+ "If you positively want to add hpc info to the current tix file, use the RTS option --read-tix-file=yes.\n"
+ "More information can be found in the accepted GHC proposal 612.\n");
+ readTix();
+ } else if ((RtsFlags.HpcFlags.readTixFile == HPC_YES_EXPLICIT) && init_open(__rts_fopen(tixFilename,"r"))) {
readTix();
}
}
=====================================
rts/Interpreter.c
=====================================
@@ -4,6 +4,30 @@
* Copyright (c) The GHC Team, 1994-2002.
* ---------------------------------------------------------------------------*/
+/*
+Note [CBV Functions and the interpreter]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the byte code interpreter loads a reference to a value it often
+ends up as a non-tagged pointers *especially* if we already know a value
+is a certain constructor and therefore don't perform an eval on the reference.
+This causes friction with CBV functions which assume
+their value arguments are properly tagged by the caller.
+
+In order to ensure CBV functions still get passed tagged functions we have
+three options:
+a) Special case the interpreter behaviour into the tag inference analysis.
+ If we assume the interpreter can't properly tag value references the STG passes
+ would then wrap such calls in appropriate evals which are executed at runtime.
+ This would ensure tags by doing additional evals at runtime.
+b) When the interpreter pushes references for known constructors instead of
+ pushing the objects address add the tag to the value pushed. This is what
+ the NCG backends do.
+c) When the interpreter pushes a reference inspect the closure of the object
+ and apply the appropriate tag at runtime.
+
+For now we use approach c). Mostly because it's easiest to implement. We also don't
+tag functions as tag inference currently doesn't rely on those being properly tagged.
+*/
#include "rts/PosixSource.h"
#include "Rts.h"
@@ -290,6 +314,18 @@ STATIC_INLINE StgClosure *tagConstr(StgClosure *con) {
return TAG_CLOSURE(stg_min(TAG_MASK, 1 + GET_TAG(con)), con);
}
+// Compute the pointer tag for the function and tag the pointer;
+STATIC_INLINE StgClosure *tagFun(StgClosure *fun) {
+ StgHalfWord tag = GET_TAG(fun);
+ if(tag > TAG_MASK) { return fun; }
+ else {
+ return TAG_CLOSURE(tag, fun);
+ }
+
+
+}
+
+
static StgWord app_ptrs_itbl[] = {
(W_)&stg_ap_p_info,
(W_)&stg_ap_pp_info,
@@ -1304,7 +1340,52 @@ run_BCO:
case bci_PUSH_G: {
W_ o1 = BCO_GET_LARGE_ARG;
- SpW(-1) = BCO_PTR(o1);
+ StgClosure *tagged_obj = (StgClosure*) BCO_PTR(o1);
+
+ tag_push_g:
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR((StgClosure*) tagged_obj));
+ // Here we make sure references we push are tagged.
+ // See Note [CBV Functions and the interpreter] in Info.hs
+
+ //Safe some memory reads if we already have a tag.
+ if(GET_CLOSURE_TAG(tagged_obj) == 0) {
+ StgClosure *obj = UNTAG_CLOSURE(tagged_obj);
+ switch ( get_itbl(obj)->type ) {
+ case IND:
+ case IND_STATIC:
+ {
+ tagged_obj = ACQUIRE_LOAD(&((StgInd*)obj)->indirectee);
+ goto tag_push_g;
+ }
+ case CONSTR:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_2_0:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
+ case CONSTR_NOCAF:
+ // The value is already evaluated, so we can just return it. However,
+ // before we do, we MUST ensure that the pointer is tagged, because we
+ // might return to a native `case` expression, which assumes the returned
+ // pointer is tagged so it can use the tag to select an alternative.
+ tagged_obj = tagConstr(obj);
+ break;
+ case FUN:
+ case FUN_1_0:
+ case FUN_0_1:
+ case FUN_2_0:
+ case FUN_1_1:
+ case FUN_0_2:
+ case FUN_STATIC:
+ // Purely for performance since we already hit memory anyway.
+ tagged_obj = tagFun(obj);
+ break;
+ default:
+ break;
+ }
+ }
+
+ SpW(-1) = (W_) tagged_obj;
Sp_subW(1);
goto nextInsn;
}
=====================================
rts/RtsFlags.c
=====================================
@@ -297,6 +297,7 @@ void initRtsFlagsDefaults(void)
RtsFlags.TickyFlags.showTickyStats = false;
RtsFlags.TickyFlags.tickyFile = NULL;
#endif
+ RtsFlags.HpcFlags.readTixFile = HPC_YES_IMPLICIT;
RtsFlags.HpcFlags.writeTixFile = true;
}
@@ -565,6 +566,10 @@ usage_text[] = {
" HeapOverflow exception before the exception is thrown again, if",
" the program is still exceeding the heap limit.",
"",
+" --read-tix-file=<yes|no>",
+" Whether to initialize HPC datastructures from <program>.tix "
+" at the start of execution. (default: yes)",
+"",
" --write-tix-file=<yes|no>",
" Whether to write <program>.tix at the end of execution.",
" (default: yes)",
@@ -1068,6 +1073,16 @@ error = true;
RtsFlags.GcFlags.nonmovingDenseAllocatorCount = threshold;
}
}
+ else if (strequal("read-tix-file=yes",
+ &rts_argv[arg][2])) {
+ OPTION_UNSAFE;
+ RtsFlags.HpcFlags.readTixFile = HPC_YES_EXPLICIT;
+ }
+ else if (strequal("read-tix-file=no",
+ &rts_argv[arg][2])) {
+ OPTION_UNSAFE;
+ RtsFlags.HpcFlags.readTixFile = HPC_NO_EXPLICIT;
+ }
else if (strequal("write-tix-file=yes",
&rts_argv[arg][2])) {
OPTION_UNSAFE;
=====================================
rts/include/rts/Flags.h
=====================================
@@ -302,10 +302,26 @@ typedef struct _PAR_FLAGS {
bool setAffinity; /* force thread affinity with CPUs */
} PAR_FLAGS;
+/* Corresponds to the RTS flag `--read-tix-file=<yes|no>`.
+ * The accepted GHC proposal 612 introduced a one-release warning period
+ * during which we emit a warning if we read a .tix file and the flag
+ * isn't explicitly set. In order to distinguish between whether the flag
+ * was explicitly set or defaulted we need to use a tri-state variable.
+ */
+typedef enum _HPC_READ_FILE {
+ HPC_NO_EXPLICIT = 0, /* The user has specified --read-tix-file=no */
+ HPC_YES_IMPLICIT = 1, /* The user hasn't specified an option and we emit
+ * a warning when we read a tix file.
+ */
+ HPC_YES_EXPLICIT = 2 /* The user has specified --read-tix-file=yes */
+ } HPC_READ_FILE;
+
/* See Note [Synchronization of flags and base APIs] */
typedef struct _HPC_FLAGS {
bool writeTixFile; /* Whether the RTS should write a tix
file at the end of execution */
+ HPC_READ_FILE readTixFile; /* Whether the RTS should read a tix
+ file at the beginning of execution */
} HPC_FLAGS;
/* See Note [Synchronization of flags and base APIs] */
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9105,7 +9105,7 @@ module GHC.RTS.Flags where
type GiveGCStats :: *
data GiveGCStats = NoGCStats | CollectGCStats | OneLineGCStats | SummaryGCStats | VerboseGCStats
type HpcFlags :: *
- data HpcFlags = HpcFlags {writeTixFile :: GHC.Types.Bool}
+ data HpcFlags = HpcFlags {readTixFile :: GHC.Types.Bool, writeTixFile :: GHC.Types.Bool}
type IoManagerFlag :: *
data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy
type IoSubSystem :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -12147,7 +12147,7 @@ module GHC.RTS.Flags where
type GiveGCStats :: *
data GiveGCStats = NoGCStats | CollectGCStats | OneLineGCStats | SummaryGCStats | VerboseGCStats
type HpcFlags :: *
- data HpcFlags = HpcFlags {writeTixFile :: GHC.Types.Bool}
+ data HpcFlags = HpcFlags {readTixFile :: GHC.Types.Bool, writeTixFile :: GHC.Types.Bool}
type IoManagerFlag :: *
data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy
type IoSubSystem :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -9329,7 +9329,7 @@ module GHC.RTS.Flags where
type GiveGCStats :: *
data GiveGCStats = NoGCStats | CollectGCStats | OneLineGCStats | SummaryGCStats | VerboseGCStats
type HpcFlags :: *
- data HpcFlags = HpcFlags {writeTixFile :: GHC.Types.Bool}
+ data HpcFlags = HpcFlags {readTixFile :: GHC.Types.Bool, writeTixFile :: GHC.Types.Bool}
type IoManagerFlag :: *
data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy
type IoSubSystem :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9105,7 +9105,7 @@ module GHC.RTS.Flags where
type GiveGCStats :: *
data GiveGCStats = NoGCStats | CollectGCStats | OneLineGCStats | SummaryGCStats | VerboseGCStats
type HpcFlags :: *
- data HpcFlags = HpcFlags {writeTixFile :: GHC.Types.Bool}
+ data HpcFlags = HpcFlags {readTixFile :: GHC.Types.Bool, writeTixFile :: GHC.Types.Bool}
type IoManagerFlag :: *
data IoManagerFlag = IoManagerFlagAuto | IoManagerFlagSelect | IoManagerFlagMIO | IoManagerFlagWinIO | IoManagerFlagWin32Legacy
type IoSubSystem :: *
=====================================
testsuite/tests/th/should_compile/T24870/Def.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module SDef where
+
+{-# NOINLINE aValue #-}
+aValue = True
+
+{-# NOINLINE aStrictFunction #-}
+aStrictFunction !x = [| x |]
=====================================
testsuite/tests/th/should_compile/T24870/T24870.stderr
=====================================
@@ -0,0 +1,2 @@
+[1 of 2] Compiling SDef ( Def.hs, Def.o, Def.dyn_o )
+[2 of 2] Compiling SUse ( Use.hs, Use.o )
=====================================
testsuite/tests/th/should_compile/T24870/T24870.stderr-mingw32
=====================================
@@ -0,0 +1,2 @@
+[1 of 2] Compiling SDef ( Def.hs, Def.o )
+[2 of 2] Compiling SUse ( Use.hs, Use.o )
=====================================
testsuite/tests/th/should_compile/T24870/Use.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module SUse where
+
+import qualified Language.Haskell.TH.Syntax as TH
+import SDef
+import GHC.Exts
+
+bar = $( inline aStrictFunction aValue )
=====================================
testsuite/tests/th/should_compile/T24870/all.T
=====================================
@@ -0,0 +1,6 @@
+# The interpreter must uphold tagging invariants, and failed to do so in #24870
+# We test this here by having the interpreter calls a strict worker function
+# with a reference to a value it constructed.
+# See also Note [CBV Functions and the interpreter]
+test('T24870', [extra_files(['Def.hs', 'Use.hs']), req_th],
+ multimod_compile, ['Def Use', '-dtag-inference-checks'])
=====================================
testsuite/tests/typecheck/T24026/T24026a.hs
=====================================
@@ -0,0 +1,7 @@
+-- This rule has a type error on the LHS
+module T24026a where
+
+{-# RULES "f" forall (x :: Bool). f x = 0 #-}
+
+f :: Int -> Int
+f x = 0
=====================================
testsuite/tests/typecheck/T24026/T24026a.stderr
=====================================
@@ -0,0 +1,9 @@
+T24026a.hs:4:11: warning: [GHC-95396] [-Winline-rule-shadowing (in -Wdefault)]
+ Rule "f" may never fire because ‘f’ might inline first
+ Suggested fix: Add an INLINE[n] or NOINLINE[n] pragma for ‘f’
+
+T24026a.hs:4:37: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match expected type ‘Int’ with actual type ‘Bool’
+ • In the first argument of ‘f’, namely ‘x’
+ In the expression: f x
+ When checking the rewrite rule "f"
\ No newline at end of file
=====================================
testsuite/tests/typecheck/T24026/T24026b.hs
=====================================
@@ -0,0 +1,7 @@
+-- This rule has a type error on the LHS
+module T24026b where
+
+{-# RULES "f" forall (x :: Bool). f x = 0 #-}
+
+f :: Int -> Int
+f x = 0
=====================================
testsuite/tests/typecheck/T24026/T24026b.stderr
=====================================
@@ -0,0 +1,5 @@
+T24026b.hs:4:37: error: [GHC-83865]
+ • Couldn't match expected type ‘Int’ with actual type ‘Bool’
+ • In the first argument of ‘f’, namely ‘x’
+ In the expression: f x
+ When checking the rewrite rule "f"
\ No newline at end of file
=====================================
testsuite/tests/typecheck/T24026/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T24026a', normal, compile, ['-dlint -fdefer-type-errors'])
+test('T24026b', normal, compile_fail, [''])
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d93014c4808da90d68c3b43b97afb2066fc94724...460e65edf5851696f15c250390c057f2e55fe59e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d93014c4808da90d68c3b43b97afb2066fc94724...460e65edf5851696f15c250390c057f2e55fe59e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240617/7fb52133/attachment-0001.html>
More information about the ghc-commits
mailing list