[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Cmm constant folding: Narrow results to operations bitwidth.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Nov 27 17:14:29 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
df42ba16 by Andreas Klebinger at 2024-11-27T11:40:49-05:00
Cmm constant folding: Narrow results to operations bitwidth.
When constant folding ensure the result is still within bounds
for the given type by explicitly narrowing the results.
Not doing so results in a lot of spurious assembler warnings
especially when testing primops.
- - - - -
bf3db97e by Ben Gamari at 2024-11-27T11:41:26-05:00
ghc-toolchain: Introduce basic flag validation
We verify that required flags (currently `--output` and `--triple`) are
provided. The implementation is truly awful, but so is getopt.
Begins to address #25500.
- - - - -
a104508d by Ben Gamari at 2024-11-27T11:42:03-05:00
rts: Allow ExecPage to allocate anywhere in address space
Currently the ExecPage facility has two users:
* GHCi, for constructing info tables, and
* the adjustor allocation path
Despite neither of these have any spatial locality constraints ExecPage
was using the linker's `mmapAnonForLinker`, which tries hard to ensure
that mappings end up nearby the executable image. This makes adjustor
allocation needlessly subject to fragmentation concerns.
We now instead return less constrained mappings, improving the
robustness of the mechanism.
Addresses #25503.
- - - - -
c3fc9b86 by Ben Gamari at 2024-11-27T11:42:39-05:00
base: Fix incorrect mentions of GHC.Internal.Numeric
These were incorrectly changed by the automated refactoring of the
`ghc-internal` migration.
Fixes #25521.
- - - - -
3f04e373 by sheaf at 2024-11-27T12:13:57-05:00
Add checkExact to toolTargets
This change means that the Hadrian multi target will include exactprint.
In particular, this means that HLS will work on exactprint inside the GHC tree.
- - - - -
dc7952b3 by Arnaud Spiwack at 2024-11-27T12:14:13-05:00
Add test for #25428
- - - - -
6b1c6b95 by Arnaud Spiwack at 2024-11-27T12:14:13-05:00
Don't bypass MonoLocalBind in empty patterns
Fixes #25428
- - - - -
20 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Tc/Gen/Bind.hs
- hadrian/src/Rules/ToolArgs.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/Prelude.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- rts/ExecPage.c
- rts/linker/MMap.c
- rts/linker/MMap.h
- + testsuite/tests/cmm/opt/T24556.cmm
- testsuite/tests/cmm/opt/all.T
- + testsuite/tests/linear/should_compile/T25428.hs
- testsuite/tests/linear/should_compile/all.T
- utils/ghc-toolchain/exe/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -279,7 +279,7 @@ basicKnownKeyNames
-- Dynamic
toDynName,
- -- GHC.Internal.Numeric stuff
+ -- Numeric stuff
negateName, minusName, geName, eqName,
mkRationalBase2Name, mkRationalBase10Name,
=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -49,6 +49,7 @@ constantFoldExprOpt e = wrapRecExpOpt f e
CmmMachOp op' args' -> fromMaybe (CmmMachOp op' args') <$> cmmMachOpFoldOptM cfg op' args'
e -> pure e
f (CmmRegOff r 0) = pure (CmmReg r)
+ f (CmmLit (CmmInt x rep)) = pure (CmmLit $ CmmInt (narrowU rep x) rep)
f e = pure e
constantFoldExpr :: Platform -> CmmExpr -> CmmExpr
@@ -88,7 +89,7 @@ cmmMachOpFoldM _ (MO_VF_Broadcast lg _w) exprs =
_ -> Nothing
cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
= Just $! case op of
- MO_S_Neg _ -> CmmLit (CmmInt (-x) rep)
+ MO_S_Neg _ -> CmmLit (CmmInt (narrowS rep (-x)) rep)
MO_Not _ -> CmmLit (CmmInt (complement x) rep)
-- these are interesting: we must first narrow to the
@@ -164,9 +165,9 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform))
MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform))
- MO_Add r -> Just $! CmmLit (CmmInt (x + y) r)
- MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r)
- MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r)
+ MO_Add r -> Just $! CmmLit (CmmInt (narrowU r $ x + y) r)
+ MO_Sub r -> Just $! CmmLit (CmmInt (narrowS r $ x - y) r)
+ MO_Mul r -> Just $! CmmLit (CmmInt (narrowU r $ x * y) r)
MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r)
MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r)
MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_s `quot` y_s) r)
@@ -176,7 +177,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r)
MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r)
- MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
+ MO_Shl r -> Just $! CmmLit (CmmInt (narrowU r $ x `shiftL` fromIntegral y) r)
MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
MO_S_Shr r -> Just $! CmmLit (CmmInt (x_s `shiftR` fromIntegral y) r)
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -347,7 +347,7 @@ impliedXFlags
, (LangExt.UnliftedDatatypes, On LangExt.DataKinds)
, (LangExt.UnliftedDatatypes, On LangExt.StandaloneKindSignatures)
- -- See Note [Non-variable pattern bindings aren't linear] in GHC.Tc.Gen.Bind
+ -- See (NVP3) in Note [Non-variable pattern bindings aren't linear] in GHC.Tc.Gen.Bind
, (LangExt.LinearTypes, On LangExt.MonoLocalBinds)
]
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -682,7 +682,6 @@ it's all cool; each signature has distinct type variables from the renamer.)
{- Note [Non-variable pattern bindings aren't linear]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
A fundamental limitation of the typechecking algorithm is that we cannot have a
binding which, at the same time,
- is linear in its rhs
@@ -694,17 +693,35 @@ https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0111-linear
To address this we to do a few things
-- When a pattern is annotated with a multiplicity annotation `let %q pat = rhs
+- (NVP1) When a pattern is annotated with a multiplicity annotation `let %q pat = rhs
in body` (note: multiplicity-annotated bindings are always parsed as a
PatBind, see Note [Multiplicity annotations] in Language.Haskell.Syntax.Binds),
- then the let is never generalised (we use the NoGen plan).
-- Whenever the typechecker infers an AbsBind *and* the inner binding is a
+ then the let is never generalised (we use the NoGen plan). We do this with a
+ dedicated test in decideGeneralisationPlan.
+- (NVP2) Whenever the typechecker infers an AbsBind *and* the inner binding is a
non-variable PatBind, then the multiplicity of the binding is inferred to be
- Many. This is a little infelicitous: sometimes the typechecker infers an
- AbsBind where it didn't need to. This may cause some programs to be spuriously
- rejected, when NoMonoLocalBinds is on.
-- LinearLet implies MonoLocalBinds to avoid the AbsBind case altogether.
-
+ Many. We do this by calling manyIfPats in tcPolyInfer. This is a little
+ infelicitous: sometimes the typechecker infers an AbsBind where it didn't need
+ to. This may cause some programs to be spuriously rejected, when
+ NoMonoLocalBinds is on.
+- (NVP3) LinearLet implies MonoLocalBinds to avoid the AbsBind case altogether.
+- (NVP4) Wrinkle: even when other conditions (including MonoLocalBinds), GHC
+ will generalise some binders, namely so-called closed binding groups. We need
+ to make sure that the test for (NVP1) has priority over the test for closed
+ binders.
+- (NVP5) Wrinkle: Closed binding groups (NVP4) are usually fine to type with
+ multiplicity Many. But there's one exception: when there's no binder at all,
+ the binding group is considered closed. Even if the rhs contains arbitrary
+ variables.
+
+ f :: () %1 -> Bool
+ f x = let !() = x in True
+
+ If we consider `!() = x` as a generalisable group (which does nothing anyway),
+ then (NVP2) will infer the pattern as multiplicity Many, and reject the
+ function. We don't want that, see also #25428. So we take care not to
+ generalise in this case, by excluding the no-binder case from automatic
+ generalisation in decideGeneralisationPlan.
-}
tcPolyInfer
@@ -722,7 +739,7 @@ tcPolyInfer top_lvl rec_tc prag_fn tc_sig_fn bind_list
; apply_mr <- checkMonomorphismRestriction mono_infos bind_list
-- AbsBinds which are PatBinds can't be linear.
- -- See Note [Non-variable pattern bindings aren't linear]
+ -- See (NVP2) in Note [Non-variable pattern bindings aren't linear]
; manyIfPats binds'
; traceTc "tcPolyInfer" (ppr apply_mr $$ ppr (map mbi_sig mono_infos))
@@ -1826,12 +1843,17 @@ decideGeneralisationPlan dflags top_lvl closed sig_fn lbinds
-- See Note [Always generalise top-level bindings]
| has_mult_anns_and_pats = False
- -- See Note [Non-variable pattern bindings aren't linear]
+ -- See (NVP1) and (NVP4) in Note [Non-variable pattern bindings aren't linear]
- | IsGroupClosed _ True <- closed = True
+ | IsGroupClosed _ True <- closed
+ , not (null binders) = True
-- The 'True' means that all of the group's
-- free vars have ClosedTypeId=True; so we can ignore
- -- -XMonoLocalBinds, and generalise anyway
+ -- -XMonoLocalBinds, and generalise anyway.
+ -- Except if 'fv' is empty: there is no binder to generalise, so
+ -- generalising does nothing. And trying to generalise hurts linear
+ -- types (see #25428). So we don't force it.
+ -- See (NVP5) in Note [Non-variable pattern bindings aren't linear] in GHC.Tc.Gen.Bind.
| has_partial_sigs = True
-- See Note [Partial type signatures and generalisation]
=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -146,6 +146,7 @@ mkToolTarget es p = do
toolTargets :: [Package]
toolTargets = [ cabalSyntax
, cabal
+ , checkExact
, compiler
, directory
, process
=====================================
libraries/base/src/Data/Char.hs
=====================================
@@ -42,7 +42,7 @@ module Data.Char
, digitToInt
, intToDigit
- -- * GHC.Internal.Numeric representations
+ -- * Numeric representations
, ord
, chr
=====================================
libraries/base/src/Data/Semigroup.hs
=====================================
@@ -89,7 +89,7 @@ module Data.Semigroup (
, First(..)
, Last(..)
, WrappedMonoid(..)
- -- * Re-exported monoids from GHC.Internal.Data.Monoid
+ -- * Re-exported monoids
, Dual(..)
, Endo(..)
, All(..)
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -47,11 +47,11 @@ module Prelude (
-- ** Numbers
- -- *** GHC.Internal.Numeric types
+ -- *** Numeric types
Int, Integer, Float, Double,
Rational, Word,
- -- *** GHC.Internal.Numeric type classes
+ -- *** Numeric type classes
Num((+), (-), (*), negate, abs, signum, fromInteger),
Real(toRational),
Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
@@ -63,7 +63,7 @@ module Prelude (
encodeFloat, exponent, significand, scaleFloat, isNaN,
isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
- -- *** GHC.Internal.Numeric functions
+ -- *** Numeric functions
subtract, even, odd, gcd, lcm, (^), (^^),
fromIntegral, realToFrac,
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -2355,7 +2355,7 @@ getTag :: forall {lev :: Levity} (a :: TYPE (BoxedRep lev))
getTag = dataToTag#
----------------------------------------------
--- GHC.Internal.Numeric primops
+-- Numeric primops
----------------------------------------------
-- Definitions of the boxed PrimOps; these will be
=====================================
libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
=====================================
@@ -47,7 +47,7 @@ module GHC.Internal.Foreign.C.Types
, CLLong(..), CULLong(..), CBool(..)
, CIntPtr(..), CUIntPtr(..), CIntMax(..), CUIntMax(..)
- -- ** GHC.Internal.Numeric types
+ -- ** Numeric types
-- | These types are represented as @newtype at s of basic
-- foreign types, and are instances of
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -551,7 +551,7 @@ instance Read L.Lexeme where
readList = readListDefault
--------------------------------------------------------------
--- GHC.Internal.Numeric instances of Read
+-- Numeric instances of Read
--------------------------------------------------------------
readNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a
=====================================
libraries/ghc-internal/src/GHC/Internal/Real.hs
=====================================
@@ -360,7 +360,7 @@ numericEnumFrom :: (Fractional a) => a -> [a]
{-# INLINE numericEnumFrom #-} -- See Note [Inline Enum method helpers] in GHC.Internal.Enum
numericEnumFrom n = go 0
where
- -- See Note [GHC.Internal.Numeric Stability of Enumerating Floating Numbers]
+ -- See Note [Numeric Stability of Enumerating Floating Numbers]
go !k = let !n' = n + k
in n' : go (k + 1)
@@ -369,7 +369,7 @@ numericEnumFromThen :: (Fractional a) => a -> a -> [a]
numericEnumFromThen n m = go 0
where
step = m - n
- -- See Note [GHC.Internal.Numeric Stability of Enumerating Floating Numbers]
+ -- See Note [Numeric Stability of Enumerating Floating Numbers]
go !k = let !n' = n + k * step
in n' : go (k + 1)
@@ -386,7 +386,7 @@ numericEnumFromThenTo e1 e2 !e3
!predicate | e2 >= e1 = (<= e3 + mid)
| otherwise = (>= e3 + mid)
-{- Note [GHC.Internal.Numeric Stability of Enumerating Floating Numbers]
+{- Note [Numeric Stability of Enumerating Floating Numbers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When enumerate floating numbers, we could add the increment to the last number
at every run (as what we did previously):
=====================================
rts/ExecPage.c
=====================================
@@ -10,7 +10,7 @@
#include "linker/MMap.h"
ExecPage *allocateExecPage(void) {
- ExecPage *page = (ExecPage *) mmapAnonForLinker(getPageSize());
+ ExecPage *page = (ExecPage *) mmapAnon(getPageSize());
return page;
}
=====================================
rts/linker/MMap.c
=====================================
@@ -207,6 +207,12 @@ memoryAccessToProt(MemoryAccess access)
}
}
+void *
+mmapAnon (size_t bytes)
+{
+ return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
+}
+
//
// Returns NULL on failure.
//
@@ -410,6 +416,15 @@ mmapForLinker (size_t bytes, MemoryAccess access, uint32_t flags, int fd, int of
return result;
}
+/*
+ * Map read/write pages anywhere in memory. Returns NULL on failure.
+ */
+void *
+mmapAnon (size_t bytes)
+{
+ return mmapAnywhere(bytes, MEM_READ_WRITE_THEN_READ_EXECUTE, MAP_ANONYMOUS, -1, 0);
+}
+
/*
* Map read/write pages in low memory. Returns NULL on failure.
*/
=====================================
rts/linker/MMap.h
=====================================
@@ -64,7 +64,11 @@ typedef enum {
extern void *mmap_32bit_base;
-// Map read/write anonymous memory.
+// Map read/write anonymous memory anywhere in memory.
+void *mmapAnon(size_t bytes);
+
+// Map read/write anonymous memory, enforcing the constraint of
+// placing the mapping within 4GB of the executable image.
void *mmapAnonForLinker (size_t bytes);
// Change protection of previous mapping memory.
=====================================
testsuite/tests/cmm/opt/T24556.cmm
=====================================
@@ -0,0 +1,12 @@
+#include "Cmm.h"
+
+func(W_ buffer) {
+ I8[buffer] = %lobits8(255 + 45);
+ I8[buffer+(1)] = %lobits8(310 - 10);
+ I8[buffer+(2)] = %lobits8(30 * 10);
+ I8[buffer+(3)] = %lobits8(150 << 1);
+ // This one comes from test-primops
+ I64[buffer+(4)] = %zx64(((1 :: bits16) & ((1 :: bits16) & (((516 :: bits16) * (154 :: bits16)) + bits16[buffer + (0 :: W_)]))));
+ return(1);
+}
+
=====================================
testsuite/tests/cmm/opt/all.T
=====================================
@@ -3,3 +3,8 @@
test('T15188', cmm_src, makefile_test, [])
test('T18141', normal, compile, [''])
test('T20142', normal, compile, [''])
+
+# Cmm opt should not produce oversized literals in the assembly output.
+# We check this by telling the assembler to exit on warnings.
+test('T24556', [only_ways('optasm'), cmm_src], compile, ['-O -opta -Xassembler -opta --fatal-warnings'])
+
=====================================
testsuite/tests/linear/should_compile/T25428.hs
=====================================
@@ -0,0 +1,6 @@
+{-# language LinearTypes #-}
+
+module T25428 where
+
+f :: () %1 -> Int
+f x = let !() = x in 0
=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -48,3 +48,4 @@ test('LinearLetPoly', normal, compile, [''])
test('LinearListComprehension', normal, compile, ['-dlinear-core-lint'])
test('OmitFieldPat', normal, compile, ['-dcore-lint'])
test('T25515', normal, compile, ['-dcore-lint'])
+test('T25428', normal, compile, [''])
=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -35,11 +35,11 @@ import GHC.Toolchain.NormaliseTriple (normaliseTriple)
import Text.Read (readMaybe)
data Opts = Opts
- { optTriple :: String
+ { optTriple :: Maybe String
, optTargetPrefix :: Maybe String
, optLocallyExecutable :: Maybe Bool
, optLlvmTriple :: Maybe String
- , optOutput :: String
+ , optOutput :: Maybe String
, optCc :: ProgOpt
, optCxx :: ProgOpt
, optCpp :: ProgOpt
@@ -82,11 +82,11 @@ emptyFormatOpts = FormatOpts { formatOptInput = error "formatOpts: input"
emptyOpts :: Opts
emptyOpts = Opts
- { optTriple = ""
+ { optTriple = Nothing
, optTargetPrefix = Nothing
, optLocallyExecutable = Nothing
, optLlvmTriple = Nothing
- , optOutput = ""
+ , optOutput = Nothing
, optCc = po0
, optCxx = po0
, optCpp = po0
@@ -129,13 +129,13 @@ _optMergeObjs = Lens optMergeObjs (\x o -> o {optMergeObjs=x})
_optWindres = Lens optWindres (\x o -> o {optWindres=x})
_optLd = Lens optLd (\x o -> o {optLd= x})
-_optTriple :: Lens Opts String
+_optTriple :: Lens Opts (Maybe String)
_optTriple = Lens optTriple (\x o -> o {optTriple=x})
_optLlvmTriple :: Lens Opts (Maybe String)
_optLlvmTriple = Lens optLlvmTriple (\x o -> o {optLlvmTriple=x})
-_optOutput :: Lens Opts String
+_optOutput :: Lens Opts (Maybe String)
_optOutput = Lens optOutput (\x o -> o {optOutput=x})
_optTargetPrefix :: Lens Opts (Maybe String)
@@ -213,7 +213,7 @@ options =
, Option [] ["disable-" ++ optName] (NoArg (set lens (Just False))) ("Disable " ++ description)
]
- tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple"
+ tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple . Just) "TRIPLE") "Target triple"
llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVM-TRIPLE") "LLVM Target triple"
targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX")
@@ -233,7 +233,7 @@ options =
keepTempOpt = Option [] ["keep-temp"] (NoArg (set _optKeepTemp True))
"do not remove temporary files"
- outputOpt = Option ['o'] ["output"] (ReqArg (set _optOutput) "OUTPUT")
+ outputOpt = Option ['o'] ["output"] (ReqArg (set _optOutput . Just) "OUTPUT")
"The output path for the generated target toolchain configuration"
formatOpts :: [OptDescr (FormatOpts -> FormatOpts)]
@@ -244,6 +244,16 @@ formatOpts = [
"The target file to format")
]
+validateOpts :: Opts -> [String]
+validateOpts opts = mconcat
+ [ assertJust _optTriple "missing --triple flag"
+ , assertJust _optOutput "missing --output flag"
+ ]
+ where
+ assertJust :: Lens Opts (Maybe a) -> String -> [String]
+ assertJust lens msg =
+ [ msg | Nothing <- pure $ view lens opts ]
+
main :: IO ()
main = do
argv <- getArgs
@@ -273,14 +283,14 @@ doFormat args = do
doConfigure :: [String] -> IO ()
doConfigure args = do
- let (opts0, _nonopts, errs) = getOpt RequireOrder options args
+ let (opts0, _nonopts, parseErrs) = getOpt RequireOrder options args
let opts = foldr (.) id opts0 emptyOpts
- case errs of
+ case parseErrs ++ validateOpts opts of
[] -> do
let env = Env { verbosity = optVerbosity opts
, targetPrefix = case optTargetPrefix opts of
Just prefix -> Just prefix
- Nothing -> Just $ optTriple opts ++ "-"
+ Nothing -> Just $ fromMaybe (error "undefined triple") (optTriple opts) ++ "-"
, keepTemp = optKeepTemp opts
, canLocallyExecute = fromMaybe True (optLocallyExecutable opts)
, logContexts = []
@@ -289,7 +299,7 @@ doConfigure args = do
case r of
Left err -> print err >> exitWith (ExitFailure 2)
Right () -> return ()
- _ -> do
+ errs -> do
mapM_ putStrLn errs
putStrLn $ usageInfo "ghc-toolchain" options
exitWith (ExitFailure 1)
@@ -298,7 +308,7 @@ run :: Opts -> M ()
run opts = do
tgt <- mkTarget opts
logDebug $ "Final Target: " ++ show tgt
- let file = optOutput opts
+ let file = fromMaybe (error "undefined --output") (optOutput opts)
writeFile file (show tgt)
optional :: M a -> M (Maybe a)
@@ -390,7 +400,7 @@ ldOverrideWhitelist a =
mkTarget :: Opts -> M Target
mkTarget opts = do
- normalised_triple <- normaliseTriple (optTriple opts)
+ normalised_triple <- normaliseTriple (fromMaybe (error "missing --triple") (optTriple opts))
-- Use Llvm target if specified, otherwise use triple as llvm target
let tgtLlvmTarget = fromMaybe normalised_triple (optLlvmTriple opts)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76bc29cfd7e9afa19eb8b48453d08872e5bf5f3f...6b1c6b958a3791d1c584d968034fbe4883124772
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76bc29cfd7e9afa19eb8b48453d08872e5bf5f3f...6b1c6b958a3791d1c584d968034fbe4883124772
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/20241127/15256842/attachment-0001.html>
More information about the ghc-commits
mailing list